パワーポイントでもマクロしたい
てっちゃん＠ラクするために苦労を惜しまずパワーポイント（以下、パワポ）でマクロを使う際の備忘録です。
CONTENTS
スライドを追加する
|
1 2 3 |
Sub スライドを追加() ActivePresentation.Slides.AddSlide 1, ActivePresentation.SlideMaster.CustomLayouts(1) End Sub |
アクティブなスライドを取得する関数 ActiveSlide
|
1 2 3 4 5 |
Public Function ActiveSlide() Dim S As Long S = ActiveWindow.Selection.SlideRange.SlideIndex Set ActiveSlide = ActivePresentation.Slides(S) End Function |
スライドの中心に、半径rの円を描きたい
スライドの中心に半径Rの円を描く
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
Sub スライドの中心に半径Rの円を描く() Dim スライドの中心X As Single Dim スライドの中心Y As Single Dim 図形の半径 As Single With ActivePresentation スライドの中心X = .PageSetup.SlideWidth / 2 スライドの中心Y = .PageSetup.SlideHeight / 2 図形の半径 = 250 ActivePresentation.Slides(1).Shapes.AddShape _ Type:=msoShapeOval, _ Left:=スライドの中心X - 図形の半径, _ Top:=スライドの中心Y - 図形の半径, _ Width:=図形の半径 * 2, _ Height:=図形の半径 * 2 End With End Sub |
図形に装飾したり
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Sub 図形に装飾したり() Dim shp As Shape Set shp = ActiveSlide.Shapes(1) shp.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground2 shp.Line.Visible = msoFalse shp.TextFrame2.TextRange.Text = "サンプルです" shp.TextFrame.TextRange.Characters.Font.Color.ObjectThemeColor = msoThemeColorDark1 shp.TextFrame.TextRange.Characters.Font.Name = "Goudy Stout" shp.TextFrame.TextRange.Characters.Font.Size = "36" shp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter shp.ThreeD.BevelTopType = msoBevelCircle shp.ThreeD.BevelTopInset = 200 shp.ThreeD.BevelTopDepth = 200 ActiveSlide.TimeLine.MainSequence.AddEffect Shape:=ActiveSlide.Shapes(1), effectId:=msoAnimEffectSpiral With ActiveSlide.Shapes(1).AnimationSettings .TextLevelEffect = ppAnimateByAllLevels .SoundEffect.ImportFromFile ActivePresentation.Path & "\ジャジャーン.wav" End With End Sub |
スライドをシャッフルしたい
|
1 2 3 4 5 6 7 8 9 10 11 |
Sub シャッフル() Randomize Dim i As Long Dim r As Long With ActivePresentation For i = 1 To .Slides.Count r = Int(Rnd * .Slides.Count) + 1 .Slides(i).MoveTo r Next i End With End Sub |
全消し
|
1 2 3 4 5 6 7 |
Sub deleteAll() Dim sd As Slide: Set sd = ActivePresentation.Slides(1) If sd.Shapes.Count <> 0 Then sd.Shapes.SelectAll ActiveWindow.Selection.Delete End If End Sub |
