用Excel绘制国旗

Option Explicit' =====延时API声明=====#If VBA7 Then    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)#Else    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)#End If'============================================================' 绘制中华人民共和国国旗（五星红旗）—— 按《国旗法》标准制图' 【修改版：运行前清空工作表所有形状 + 分步延时绘制】'============================================================Sub DrawNationalFlag()    Const GRID As Double = 15          ' 每格边长(点)。改这个值可整体缩放，比例自动保持 3:2    Const FLAGW As Double = 30 * GRID  ' 旗宽 = 30 格    Const FLAGH As Double = 20 * GRID  ' 旗高 = 20 格    Const DELAY_MS As Long = 800       ' 每步延时毫秒，800=0.8秒；调大更慢，调小变快    ' =========新增：清空当前工作表全部形状（图形、图片、文本框全部删除）=========    Dim shp As Shape    For Each shp In ActiveSheet.Shapes        shp.Delete    Next shp    DoEvents    ' 旗面左上角放到的位置(点，相对 A1 左上角)，可自行改大    Dim lft As Double, tp As Double    lft = 50    tp = 50    ' ---- 第 1 步：红色旗面矩形 ----    Dim rect As Shape    Set rect = ActiveSheet.Shapes.AddShape(msoShapeRectangle, lft, tp, FLAGW, FLAGH)    With rect        .Fill.ForeColor.RGB = RGB(222, 41, 16)   ' 国旗红(约 #DE2910)        .Line.ForeColor.RGB = RGB(222, 41, 16)   ' 边框同色，不露白边        .Name = "国旗旗面"    End With    DoEvents    Sleep DELAY_MS   ' 暂停，看旗面    Debug.Print "已绘制：红色旗面"    ' 大五角星：中心在格(4.5,4.5)，半径 3 格    Dim bCx As Double, bCy As Double, bR As Double    bCx = lft + 4.5 * GRID    bCy = tp + 4.5 * GRID    bR = 3 * GRID    ' ---- 第 2 步：大五角星（一角朝正上方，无需旋转）----    Dim s As Shape    Set s = BuildStar(bCx, bCy, bR, 0)    s.Name = "大五角星"    DoEvents    Sleep DELAY_MS    Debug.Print "已绘制：大五角星"    ' ---- 第 3 步：四颗小五角星，各有一角尖正对大星中心 ----    ' 小五角星1：格中心(9.5,1.5)，半径 1 格    Set s = BuildStar(lft + 9.5 * GRID, tp + 1.5 * GRID, GRID, _            StarRotationDeg(bCx, bCy, lft + 9.5 * GRID, tp + 1.5 * GRID))    s.Name = "小五角星1"    DoEvents    Sleep DELAY_MS    Debug.Print "已绘制：小五角星1"    ' 小五角星2：格中心(11.5,3.5)    Set s = BuildStar(lft + 11.5 * GRID, tp + 3.5 * GRID, GRID, _            StarRotationDeg(bCx, bCy, lft + 11.5 * GRID, tp + 3.5 * GRID))    s.Name = "小五角星2"    DoEvents    Sleep DELAY_MS    Debug.Print "已绘制：小五角星2"    ' 小五角星3：格中心(11.5,6.5)    Set s = BuildStar(lft + 11.5 * GRID, tp + 6.5 * GRID, GRID, _            StarRotationDeg(bCx, bCy, lft + 11.5 * GRID, tp + 6.5 * GRID))    s.Name = "小五角星3"    DoEvents    Sleep DELAY_MS    Debug.Print "已绘制：小五角星3"    ' 小五角星4：格中心(9.5,8.5)    Set s = BuildStar(lft + 9.5 * GRID, tp + 8.5 * GRID, GRID, _            StarRotationDeg(bCx, bCy, lft + 9.5 * GRID, tp + 8.5 * GRID))    s.Name = "小五角星4"    DoEvents    Sleep DELAY_MS    Debug.Print "已绘制：小五角星4"    MsgBox "标准国旗绘制完成！", vbInformation, "完成"End Sub'============================================================' 生成一颗黄色正五角星' cx,cy: 中心坐标(点)；R: 外接圆半径(点)；rotationDeg: 旋转角(度)'============================================================Function BuildStar(cx As Double, cy As Double, R As Double, rotationDeg As Double) As Shape    Const PI As Double = 3.14159265358979    Dim rad As Double    rad = 0.381966 * R        ' 内接圆半径 = R * (3-√5)/2 ≈ 0.382R    ' 预计算 10 个顶点（外顶点与内顶点交替，从 -90°即正上方起，每 36° 一个）    Dim pts(9, 1) As Double    Dim i As Long, ang As Double    For i = 0 To 9        ang = (rotationDeg - 90 + i * 36) * PI / 180        If i Mod 2 = 0 Then            pts(i, 0) = cx + R * Cos(ang)            pts(i, 1) = cy + R * Sin(ang)        Else            pts(i, 0) = cx + rad * Cos(ang)            pts(i, 1) = cy + rad * Sin(ang)        End If    Next i    ' 用 Freeform 精确描出五角星轮廓（保证各角尖完全标准）    Dim fb As FreeformBuilder    Set fb = ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, pts(0, 0), pts(0, 1))    For i = 1 To 9        fb.AddNodes msoSegmentLine, msoEditingAuto, pts(i, 0), pts(i, 1)    Next i    Dim shp As Shape    Set shp = fb.ConvertToShape    With shp        .Fill.ForeColor.RGB = RGB(255, 222, 0)   ' 五星黄(约 #FFDE00)        .Line.ForeColor.RGB = RGB(255, 222, 0)    End With    Set BuildStar = shpEnd Function'============================================================' 计算小五角星旋转角(度)，使其一个角尖正对大五角星中心'============================================================Function StarRotationDeg(bigCx As Double, bigCy As Double, smallCx As Double, smallCy As Double) As Double    Dim dx As Double, dy As Double    dx = bigCx - smallCx    dy = bigCy - smallCy    ' Excel ATAN2(dx,dy) 返回该向量相对 X 轴的角度(弧度)    Dim angRad As Double    angRad = Application.WorksheetFunction.Atan2(dx, dy)    ' 转成度，并把默认朝上的尖角转到指向大星方向    StarRotationDeg = angRad * 180 / (4 * Atn(1)) + 90End Function