|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 lee1892 于 2014-11-18 13:15 编辑
俺也来一个画图的
五环.rar
(12.94 KB, 下载次数: 9)
- Sub DrawOlympic()
- Dim dRad#, dWid#, dLeft#, dTop#, i%
- Dim dOffVer#, dOffHor#
- Dim nBlue%, nBlack%, nRed%, nYellow%, nGreen%
-
- nBlue = 48: nBlack = 8: nRed = 10: nYellow = 51: nGreen = 17
- dLeft = 150: dTop = 150
- dRad = 100: dWid = 14.5
- dOffVer = 3.4: dOffHor = 1.1
-
- With Sheet1
- For i = 1 To .Shapes.Count
- .Shapes(1).Delete
- Next
-
- With .Shapes.AddShape(msoShapeDonut, dLeft, dTop, dRad, dRad)
- .Adjustments.Item(1) = dWid / dRad
- .Fill.ForeColor.SchemeColor = nBlue
- .Line.Visible = msoFalse
- With .Duplicate
- .Left = dLeft: .Top = dTop
- .IncrementLeft dRad * dOffHor
- .Fill.ForeColor.SchemeColor = nBlack
- End With
- With .Duplicate
- .Left = dLeft: .Top = dTop
- .IncrementLeft dRad * dOffHor * 2
- .Fill.ForeColor.SchemeColor = nRed
- End With
- With .Duplicate
- .Left = dLeft: .Top = dTop
- .IncrementLeft dRad * dOffHor / 2
- .IncrementTop dRad * Sqr(2) / dOffVer
- .Fill.ForeColor.SchemeColor = nYellow
- End With
- With .Duplicate
- .Left = dLeft: .Top = dTop
- .IncrementLeft dRad * dOffHor * 3 / 2
- .IncrementTop dRad * Sqr(2) / dOffVer
- .Fill.ForeColor.SchemeColor = nGreen
- End With
- End With
-
- With .Shapes.AddShape(msoShapeBlockArc, dLeft, dTop, dRad, dRad)
- .Adjustments.Item(2) = (1 - 2 * dWid / dRad) / 2
- .IncrementRotation 35
- .Fill.ForeColor.SchemeColor = nBlue
- .Line.Visible = msoFalse
- With .Duplicate
- .Left = dLeft: .Top = dTop
- .IncrementLeft dRad * dOffHor
- .IncrementRotation 95
- .Fill.ForeColor.SchemeColor = nBlack
- End With
- With .Duplicate
- .Left = dLeft: .Top = dTop
- .IncrementLeft dRad * dOffHor * 3 / 2
- .IncrementTop dRad * Sqr(2) / dOffVer
- .IncrementRotation 5
- .Fill.ForeColor.SchemeColor = nGreen
- End With
- With .Duplicate
- .Left = dLeft: .Top = dTop
- .IncrementLeft dRad * dOffHor * 2
- .IncrementRotation -60
- .Fill.ForeColor.SchemeColor = nRed
- End With
- End With
- End With
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|