Rem ===在 powerpoint 中以VBA程式繪製彩色隨機圖形(圓形)===
Sub Macro1()
For i = 1 To 100
xx = Rnd * 640
yy = Rnd * 460
rr = Int(Rnd * 50 + 50)
If xx + rr > 720 Or yy + rr > 540 Then GoTo ccc
ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeOval, xx, yy, rr, rr).Select
With ActiveWindow.Selection.ShapeRange
.Fill.ForeColor.RGB = QBColor(Rnd * 15)
.Line.ForeColor.RGB = QBColor(Rnd * 15)
.Line.Weight = 5
.Line.DashStyle = msoLineSolid
End With
ccc:
Next i
End Sub
Rem ===在 powerpoint 中以VBA程式繪製彩色隨機圖形(矩形)===
Sub Macro2()
For i = 1 To 100
xx = Rnd * 640
yy = Rnd * 460
ww = Rnd * 100 + 50
hh = Rnd * 100 + 50
If xx + ww > 720 Or yy + hh > 540 Then GoTo ccc
ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeRectangle, xx, yy, ww, hh).Select
With ActiveWindow.Selection.ShapeRange
.Fill.ForeColor.RGB = QBColor(Rnd * 15)
.Line.ForeColor.RGB = QBColor(Rnd * 15)
End With
ccc:
Next i
End Sub
Rem === 網狀圖形之一 ===
Sub Macro4()
a = 0: b = 0: c = 0: d = 0
Do While d < 720
ActiveWindow.Selection.SlideRange.Shapes.AddLine(a, 0, 720, b).Select
ActiveWindow.Selection.SlideRange.Shapes.AddLine(0, c, d, 540).Select
a = a + 20: b = b + 15: c = b: d = a
Loop
ActiveWindow.Selection.SlideRange.Shapes.AddLine(0, 540, 720, 540).Select
ActiveWindow.Selection.SlideRange.Shapes.AddLine(720, 0, 720, 540).Select
End Sub
Rem === 網狀圖形之二 ===
Sub Macro5()
inc1 = 18: inc2 = 13.5
X1 = 720: X2 = 0: Y1 = 270: Y2 = 270
Do While X1 >= X2
ActiveWindow.Selection.SlideRange.Shapes.AddLine(X1, 270, 360, Y1).Select
ActiveWindow.Selection.SlideRange.Shapes.AddLine(360, Y1, X2, 270).Select
ActiveWindow.Selection.SlideRange.Shapes.AddLine(X2, 270, 360, Y2).Select
ActiveWindow.Selection.SlideRange.Shapes.AddLine(360, Y2, X1, 270).Select
X1 = X1 - inc1
X2 = X2 + inc1
Y1 = Y1 - inc2
Y2 = Y2 + inc2
Loop
End Sub
Rem === 網狀圖形之三(可控制大小與位置) ===
Sub Macro6()
a = 0: b = 0: c = 0: d = 0
w = 360: h = 270: x = 180: y = 135 'width, height, x0, y0
Do While d < w
ActiveWindow.Selection.SlideRange.Shapes.AddLine(a + x, 0 + y, w + x, b + y).Select
ActiveWindow.Selection.SlideRange.Shapes.AddLine(0 + x, c + y, d + x, h + y).Select
a = a + w / 36: b = b + h / 36: c = b: d = a
Loop
ActiveWindow.Selection.SlideRange.Shapes.AddLine(0 + x, h + y, w + x, h + y).Select
ActiveWindow.Selection.SlideRange.Shapes.AddLine(w + x, 0 + y, w + x, h + y).Select
End Sub
Rem === 完全圖形(點數可變化) ===
Sub Macro7()
N = 12
RADIAN = 6.2832 / N
For x = 1 To N - 1
For y = x To N
X1 = Sin(x * RADIAN) * 320 + 360
Y1 = Cos(x * RADIAN) * 240 + 270
X2 = Sin(y * RADIAN) * 320 + 360
Y2 = Cos(y * RADIAN) * 240 + 270
ActiveWindow.Selection.SlideRange.Shapes.AddLine(X1, Y1, X2, Y2).Select
Next y
Next x
End Sub
Rem === 白努力雙曲線(幸運草) ===
Sub Macro8()
For i = 1 To 200
x0 = 360: y0 = 270
theta = i * 6.2832 / 200
r = 540 / 2 * Sin(2 * theta)
Rem r = 540 / 2 * Cos(2 * theta)
x = 720 / 2 + r * Cos(theta)
y = 540 / 2 + r * Sin(theta)
ActiveWindow.Selection.SlideRange.Shapes.AddLine(x0, y0, x, y).Select
Next i
End Sub
Rem === 弦環圖形(點數,跨距可變化) ===
Sub Macro9()
N = 18
hop = 7
RADIAN = 6.2832 / N
For x = 1 To N - 1
For y = x + 1 To N
CX = Cos(x * RADIAN) * 240 + 360
SY = Sin(y * RADIAN) * 240 + 270
CY = Cos(y * RADIAN) * 240 + 360
SX = Sin(x * RADIAN) * 240 + 270
ee = y - x: ee2 = x + N - y
If ee = 1 Or ee = hop Or ee2 = 1 Or ee2 = hop Then
ActiveWindow.Selection.SlideRange.Shapes.AddLine(CX, SX, CY, SY).Select
ActiveWindow.Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 255)
End If
Next y
Next x
ActiveWindow.Selection.Unselect
End Sub
本文於 修改第 3 次