12个数字围成一个圆圈怎么做

dongdonggege

microyip 发表于 2020-4-28 14:11
既然图形是你自创的，何必直接去定义结果？

老师，我还有一个求助帖，在http://club.excelhome.net/thread-1533666-1-1.html，是关于插入的包文件，如何播放的问题，麻烦老师，个能帮忙解决，谢谢。

microyip

1. Sub 画时钟()
   
2.     Dim dicNum As Object, oShape As Object
   
3.     Dim nDiam As Double, nPointX As Double, nPointY As Double
   
4.     Dim nI As Long, nPai As Double, nX As Double, nY As Double, nWidth As Long, nHeight As Long
   
5.    
   
6.     nPointX = 210 '图形圆左位置
   
7.     nPointY = 100 '图形圆顶位置
   
8.     nDiam = 147 '图形圆直径
   
9. 
   
10.     With ActiveSheet
    
11.         For Each oShape In .Shapes
    
12.             oShape.Delete
    
13.         Next
    
14.    
    
15.         With .Shapes.AddShape(msoShapeOval, nPointX, nPointY, nDiam, nDiam)
    
16.         Debug.Print .Left & "," & .Top & "," & .Width & "," & .Height
    
17.             .Fill.ForeColor.SchemeColor = 10
    
18.             .Line.Visible = msoFalse
    
19.             .Name = "Oval 1"
    
20.         End With
    
21.         
    
22.         nPointX = nPointX + nDiam / 2
    
23.         nPointY = nPointY + nDiam / 2
    
24.         nDiam = nDiam + 30 '数字所处直径
    
25.         nHeight = 20
    
26.         nWidth = 15
    
27.         nPai = Application.WorksheetFunction.Pi
    
28. 
    
29.         For nI = 1 To 12
    
30.             If nI > 9 Then nWidth = 30
    
31.             nX = nPointX + nDiam * Cos(nPai / 2 - nI * nPai / 6) / 2 - nWidth / 2
    
32.             nY = nPointY - nDiam * Sin(nPai / 2 - nI * nPai / 6) / 2 - nHeight / 2
    
33.             With .Shapes.AddTextbox(msoTextOrientationHorizontal, nX, nY, nWidth, nHeight)
    
34.                 With .TextFrame.Characters
    
35.                     .Text = nI
    
36.                     .Font.Size = 12
    
37.                     .Font.FontStyle = "加粗"
    
38.                 End With
    
39.                 .Line.Visible = msoFalse
    
40.                 .Name = "文字" & nI
    
41.             End With
    
42.         Next
    
43.     End With
    
44. End Sub

复制代码

microyip

附上附件以供参考

dongdonggege

microyip 发表于 2020-4-28 16:59
附上附件以供参考

谢谢，谢谢老师的大力帮助。

dongdonggege

microyip 发表于 2020-4-28 16:59
附上附件以供参考

老师，我有个2003经典菜单不会，Excel的做出来了，但是PowerPoint的做不出来，麻烦帮帮我，谢谢了。
https://club.excelhome.net/thread-1654181-1-1.html