Sub 右上に数字を書いたスライドを作る()

'MsgBox (ActivePresentation.Slides.Count)

Dim pp As Presentation

Dim shp As Shape

Dim sd As Slide

Dim cm As Double, xx As Double, yy As Double, rr As Double

Dim i As Long, n As Long

Dim aa As Double

Set pp = ActivePresentation

Set pp = Presentations.Add

Set sd = pp.Slides.AddSlide(1, pp.SlideMaster.CustomLayouts(1))

Set sd = pp.Slides.AddSlide(2, pp.SlideMaster.CustomLayouts(2))

n = pp.Slides.Count

'Set sd = pp.Slides.AddSlide(n, pp.SlideMaster.CustomLayouts(2))

cm = 72 / 2.54

xx = 31.87 * cm

yy = 0

rr = 2 * cm

aa = 4

xx = 31.87 + 2 - aa

xx = xx * cm

rr = aa * cm

For i = 1 To 10

Set sd = pp.Slides(i)

nn = pp.Slides.Count

Set sd = pp.Slides.AddSlide(2, pp.SlideMaster.CustomLayouts(2))

Set shp = sd.Shapes.AddShape(msoShapeOval, xx, yy, rr, rr / 2)

shp.TextFrame2.TextRange.Characters = "" + Format(i, "0")

With shp.TextFrame2.TextRange.Font

.NameComplexScript = "Times New Roman"

.NameFarEast = "Times New Roman"

.Name = "Times New Roman"

End With

With shp.Fill

.Visible = msoTrue

.ForeColor.ObjectThemeColor = msoThemeColorBackground1

.ForeColor.TintAndShade = 0

.ForeColor.Brightness = -0.15

.Transparency = 0

.Solid

End With

With shp.Line

.Visible = msoTrue

.ForeColor.ObjectThemeColor = msoThemeColorBackground1

.ForeColor.TintAndShade = 0

.ForeColor.Brightness = -0.5

.Transparency = 0

End With

With shp.TextFrame2.TextRange.Font.Fill

.Visible = msoTrue

.ForeColor.ObjectThemeColor = msoThemeColorText1

.ForeColor.TintAndShade = 0

.ForeColor.Brightness = 0

.Transparency = 0

.Solid

End With

With shp.TextFrame2.TextRange.Characters.ParagraphFormat

' .FirstLineIndent = 0

' .Alignment = msoAlignLeft

End With

With shp.TextFrame2

.VerticalAnchor = msoAnchorMiddle

.TextRange.ParagraphFormat.Alignment = msoAlignCenter

End With

Next i

End Sub