note

ただのノート

Power Point マクロ①:プログレスバー(点)

普段、理系院生なのもあって隔週でパワポで資料を作らないといけない生活を送っているのだけれど、いちいち一から作ってたら日が暮れてしまうし余裕で徹夜している。やはり毎回毎回作っていて重複する部分はあるが使い回せないところもある。時間がないときはクオリティは下がるしやる気のない時も...(以下省略)

 

効率化はもちろん、マクロはなんかかっこいい!

 

ということで今回はまだ誰もあげてなさそうだったのでプログレスバーのバーじゃないバージョンのマクロを作ってみた。と言ってもだいたいバーのやつと中身は一緒だけれど

 

f:id:fuu2uu:20171128080411p:plain

 

イメージこんな感じ。色は変えられるし間隔もご自由にどうぞ。

一応ページ数が増えてもこんな感じに中心と間隔は変わらないようにした

f:id:fuu2uu:20171128080801p:plain

 

以下ソースコード。削除用の関数も入ってます。

 

Sub AddProgressPts()
'Const bsize As Long = 200 ' bar length
Const brate As Long = 14 '1 per length
On Error Resume Next
With ActivePresentation
bsize = brate * .Slides.Count
For Y = 2 To .Slides.Count
For X = 2 To .Slides.Count
Set s = .Slides(Y).Shapes.AddShape(msoShapeOval, _
brate / 4 + (.PageSetup.SlideWidth - bsize) / 2 + (X - 2) * bsize / (.Slides.Count - 1), _
.PageSetup.SlideHeight - 12, _
10, 10)
s.Name = "PB"
s.Fill.ForeColor.RGB = RGB(0, 60, 0)
s.Fill.Transparency = 0.8
s.Line.Visible = msoFalse
Next X:
Next Y:
End With

With ActivePresentation
For Z = 2 To .Slides.Count
Set s = .Slides(Z).Shapes.AddShape(msoShapeOval, _
brate / 4 + (.PageSetup.SlideWidth - bsize) / 2 + (Z - 2) * bsize / (.Slides.Count - 1), _
.PageSetup.SlideHeight - 12, _
10, 10)
s.Name = "PB"
s.Fill.ForeColor.RGB = RGB(0, 80, 0)
s.Fill.Transparency = 0.6
s.Line.Visible = msoFalse
Next Z:
End With
End Sub

Sub DeleteProgressPts()
On Error Resume Next
With ActivePresentation
For Y = 1 To .Slides.Count
For X = 1 To .Slides.Count
.Slides(X).Shapes("PB").Delete
Next X:
Next Y:
End With
End Sub