TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Option Explicit
' Edit these two values to change the grid spacing in inches
Const dVspacing As Double = 0.25
Const dHspacing As Double = 0.25
' Edit these three values to change the RGB color of the grid lines
Const lGridColorRed As Long = 225
Const lGridColorGreen As Long = 225
Const lGridColorblue As Long = 225

Sub ToggleGrid()
    If Len(ActiveWindow.Selection.SlideRange(1).Tags("GRIDDED")) > 0 Then
        Call RemoveGrid
    Else
        Call CreateGrid
    End If
End Sub
Function CreateGrid()
' Creates gridlines
' Edit the values below to change spacing and color

    Dim oSh As Shape
    Dim oSl As Slide
    Dim x As Double

    Dim dBeginX As Double
    Dim dBeginY As Double
    Dim dEndX As Double
    Dim dEndY As Double

    ' these hold dVspacing and dHspacing converted to points
    Dim dVspace As Double
    Dim dHspace As Double

    dVspace = dVspacing * 72
    dHspace = dHspacing * 72

    dBeginX = 0
    dBeginY = 0
    dEndX = ActivePresentation.PageSetup.Slidewidth
    dEndY = ActivePresentation.PageSetup.Slideheight

    Set oSl = ActiveWindow.Selection.SlideRange(1)
    With oSl
        ' add vertical gridlines
        For dBeginX = 0 To ActivePresentation.PageSetup.Slidewidth
            Set oSh = oSl.Shapes.AddLine(dBeginX, dBeginY, dBeginX, dEndY)
            With oSh
                ' Change RGB value here:
                .Line.ForeColor.RGB = RGB(lGridColorRed, lGridColorGreen, lGridColorblue)
                Call .Tags.Add("GRIDLINE", "YES")
            End With
            dBeginX = dBeginX + dHspace
        Next
        ' add horizontal gridlines
        dBeginX = 0
        dBeginY = 0
        For dBeginY = 0 To ActivePresentation.PageSetup.Slideheight
            Set oSh = oSl.Shapes.AddLine(dBeginX, dBeginY, dEndX, dBeginY)
            With oSh
                ' Change RGB value here:
                .Line.ForeColor.RGB = RGB(225, 225, 225)
                Call .Tags.Add("GRIDLINE", "YES")
            End With
            dBeginY = dBeginY + dVspace
        Next
        ' Mark the slide so we know that it's gridded
        Call .Tags.Add("GRIDDED", "YES")
    End With

End Function

Function RemoveGrid()
    Dim oSh As Shape
    Dim x As Long
    For x = ActiveWindow.Selection.SlideRange(1).Shapes.Count To 1 Step -1
        Set oSh = ActiveWindow.Selection.SlideRange(1).Shapes(x)
        If Len(oSh.Tags("GRIDLINE")) > 0 Then
            oSh.Delete
        End If
    Next
    ' Mark the slide so we know that it's gridded
    ActiveWindow.Selection.SlideRange(1).Tags.Delete ("GRIDDED")

End Function