Powerpoint VBA 方眼を描くマクロ ② - インストールレスプログラミング( ´ー`)

前回，方眼を作るマクロを作り，とりあえず満足していました。

矢印をそこに入れようかなと思ってみたものの，そこは自由にできたほうがいいよな，と思いグリッドと方眼を一致させることを考えました。

まずパワーポイントの仕様を理解するために眺めてみると，

スライドの真ん中がルーラーのスタート地点であることがわかる。

図で表そうとしたら面倒だったので，言葉で書きますが，中心から等間隔のグリッドを考えていって，その端数が端っこにでることがわかりました。

なので，方眼のセル幅をグリッド幅に設定して，端数をmodで計算してその分+グリッド幅の倍数を足したものを方眼を描くスタートにすればグリッドと方眼が一致するはずです。

要所を抜き出します。

グリッド間の距離をまずセル幅に一致させます。必要に応じて１／２とかをグリッド幅に設定すると要求に合うようになります。

そして，

    Dim GridDistance_ As Long
    
    ActivePresentation.GridDistance = CellWidth
    GridDistance_ = ActivePresentation.GridDistance

    StartX = ActivePresentation.SlideMaster.Width / 2 Mod GridDistance_ + CellWidth * 2
    StartY = ActivePresentation.SlideMaster.Height / 2 Mod GridDistance_ + CellWidth * 2

この部分です。スライドマスターからスライド幅をとり，グリッド幅で割ったあまりを取得して利用しています。
スライド高さも同じように利用しています。それらを利用して方眼の書き始めの点を決める。

これを前のコードに合わせると，次のようになりました。

Option Explicit

Sub 方眼作成(Rows_ As Long, Columns_ As Long, CellWidth As Long)
    
    Dim TargetSlide As Slide: Set TargetSlide = ActiveWindow.Selection.SlideRange(1)
    
    Dim Width_ As Long: Width_ = Columns_ * CellWidth
    Dim Height_ As Long: Height_ = Rows_ * CellWidth
    Dim StartX As Long, StartY As Long
    Dim GridDistance_ As Long
    
    
    ActivePresentation.GridDistance = CellWidth
    GridDistance_ = ActivePresentation.GridDistance
    
    StartX = ActivePresentation.SlideMaster.Width / 2 Mod GridDistance_ + CellWidth * 2
    StartY = ActivePresentation.SlideMaster.Height / 2 Mod GridDistance_ + CellWidth * 2
    
    Dim i As Long
    For i = 0 To Rows_
        With TargetSlide.Shapes.AddLine(StartX, StartY + CellWidth * i, StartX + Width_, StartY + CellWidth * i)
            .Name = "横" & i
            .Line.ForeColor.RGB = vbBlack
            .Line.Weight = 0.5
        End With
    Next
    
    For i = 0 To Columns_
        With TargetSlide.Shapes.AddLine(StartX + CellWidth * i, StartY, StartX + CellWidth * i, StartY + Height_)
            .Name = "縦" & i
            .Line.ForeColor.RGB = vbBlack
            .Line.Weight = 0.5
        End With
    Next

End Sub

Sub 方眼作成テスト()
    Dim ret As String: ret = InputBox("行，列，セルの大きさ?", Default:="8,10,50")
    
    Call 方眼作成(CLng(Split(ret, ",")(0)), CLng(Split(ret, ",")(1)), CLng(Split(ret, ",")(2)))
End Sub