先日のパワポマクロ「【PowerPoint】魔法のガイドラインを引くマクロ 」の改良版です。
ブログ記事を公開したところ、Microsoft MVP for Office System のきぬあささん からガイドラインの色の変更もできることを教えていただき、それもそうだと思って作り替えました。
実際に、前回マクロを使っていて不便だと思ったことがあったので、その点も修正しました。
＜目次＞
このマクロでできること
パワポの用紙サイズにかかわらず、標準画面（4：3）とワイド画面（16：9）の場合に、魔法のガイドラインを引きます。
ガイドラインには、色をつけられます。
あんまりカラフルにすると気が散りますから（笑）、私は目立ちすぎず、でも気分がよくなる色（自分の趣味で選んでますが）をつけることにしました。
マクロを実行すると以下のダイアログボックスが表示されます。
番号を入力してください。
すると、現在開かれているスライドのサイズを自動判定して、それにあったガイドラインを引きます。
たとえば、今週末のセミナー用の資料です。標準の4：3で作っています。
来週のJTFツールセミナーの資料は作り始めたばかりですが、こんな感じ。山吹色で線を引きました。
クイックアクセスツールバーのボタンは、これ！
それっぽいです。
マクロの解説
前半で、色の選択をできるようにしてみました。
インプットボックスに番号を入力し、その番号をSelect Caseステートメントで場合分けをしています。
１～３以外を入力するとマクロは終了します。
オレンジ色部分で、色の設定をしています。
青文字部分で、現在表示されている（カーソルがおかれている）スライドの寸法を取得しています。
この寸法の比率を測定してSelect Case ステートメントで処理をしています。
前回のブログで紹介した線の位置は、横幅が720ピクセルのものだったので、その比率をもとにmyRatioで計算しなおしています。
赤文字部分で、前回のマクロと同様、すでに引かれているガイドラインの削除をします。
マクロ
Sub 魔法のガイドライン2()
Dim myHeight As Single
Dim myWidth As Single
Dim myRatio As Single
Dim myColor As Long
Dim myMessage As String
'ガイドラインの色を設定
myMessage = "色を選択してください。" & vbCr & _
"1: ライムグリーン" & vbCr & _
"2: 山吹色" & vbCr & _
"3: 50%灰色"
Select Case CInt(InputBox(myMessage, "ガイドラインの色の設定", 1))
Case 1
myColor = RGB(153, 204, 0) 'ライムグリーン
Case 2
myColor = RGB(255, 153, 0) '山吹色
Case 3
myColor = RGB(128, 128, 128) '50%灰色
Case Else
Exit Sub
End Select
With Application.ActivePresentation
myHeight = .PageSetup.SlideHeight
myWidth = .PageSetup.SlideWidth
Select Case myHeight / myWidth
Case 0.75 '標準画面（4:3）
DelAllGuides
myRatio = myWidth / 720
.Guides.Add(ppHorizontalGuide, 15 * myRatio).Color = myColor
.Guides.Add(ppHorizontalGuide, 185 * myRatio).Color = myColor
.Guides.Add(ppHorizontalGuide, 270 * myRatio).Color = myColor
.Guides.Add(ppHorizontalGuide, 355 * myRatio).Color = myColor
.Guides.Add(ppHorizontalGuide, 525 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 20 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 246 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 360 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 474 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 700 * myRatio).Color = myColor
Case 0.5625 'ワイド画面（16:9）
DelAllGuides
myRatio = myWidth / 720
.Guides.Add(ppHorizontalGuide, 15 * myRatio).Color = myColor
.Guides.Add(ppHorizontalGuide, 140 * myRatio).Color = myColor
.Guides.Add(ppHorizontalGuide, 202.5 * myRatio).Color = myColor
.Guides.Add(ppHorizontalGuide, 265 * myRatio).Color = myColor
.Guides.Add(ppHorizontalGuide, 390 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 20 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 246 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 360 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 474 * myRatio).Color = myColor
.Guides.Add(ppVerticalGuide, 700 * myRatio).Color = myColor
Case Else 'その他
'何もしない
End Select
End With
'ガイドの表示
Application.DisplayGuides = True
End Sub
Private Sub DelAllGuides()
'表示中のプレゼンテーションのガイドをすべて削除する
Dim i As Long
With Application.ActivePresentation
If .Guides.Count > 0 Then
For i = .Guides.Count To 1 Step -1
.Guides(i).Delete
Next
End If
End With
End Sub