Star

Sub 星を描く()

Dim sd As Slide

Dim n As Long

Dim xx(5) As Double, yy(5) As Double, rr As Double

Dim i As Long

Dim pi As Double

pi = 3.14159265359

rr = 8 * 72 / 2.54

For i = 1 To 5

xx(i) = rr * Cos(-pi / 2 + (i) * 2 * 2 * pi / 5) + rr

yy(i) = rr * Sin(-pi / 2 + (i) * 2 * 2 * pi / 5) + rr

Next i

n = ActiveWindow.Selection.SlideRange.SlideIndex

With ActivePresentation.Slides(n).Shapes.BuildFreeform(msoEditingAuto, xx(5), yy(5))

For i = 1 To 5

.AddNodes msoSegmentCurve, msoEditingAuto, xx(i), yy(i)

Next i

.ConvertToShape.Select

End With

End Sub

Sub 星を描く2()

Dim sd As Slide

Dim n As Long

Dim xx(5) As Double, yy(5) As Double, rr As Double

Dim i As Long

Dim pi As Double

Dim sp As Shape, dd As Double

Dim r As Double, g As Double, b As Double

Dim k As Long

pi = 3.14159265359

rr = 4 * 72 / 2.54

dd = rr * 1.5

rr2 = rr

r = 245

g = 100

b = 0

For k = 0 To 5

For i = 1 To 5

xx(i) = rr * Cos(-pi / 2 - k * pi / 5 + (i) * 2 * 2 * pi / 5) + rr2

yy(i) = rr * Sin(-pi / 2 - k * pi / 5 + (i) * 2 * 2 * pi / 5) + rr

Next i

n = ActiveWindow.Selection.SlideRange.SlideIndex

With ActivePresentation.Slides(n).Shapes.BuildFreeform(msoEditingAuto, xx(5), yy(5))

For i = 1 To 5

.AddNodes msoSegmentCurve, msoEditingAuto, xx(i), yy(i)

Next i

Set sp = .ConvertToShape

End With

sp.Fill.ForeColor.RGB = RGB(r, g, b)

sp.Line.ForeColor.RGB = RGB(r + 10, g + 10, b + 10)

rr2 = rr2 + dd

r = r / 2

g = g / 2

b = b + 30

Next k

End Sub