生成多等分的圆环

> 我们平时要将环形等分，可以把图表粘贴为增强型图元文件再取消组合，也可以用插件快速分割，但得到的等分圆环都不方便再次调整。使用该代码可以快速生成多等分的圆环，而且生成的形状还能单独调整控点。

**代码如下：**

```vb
Sub 生成等分圆环()
    Dim osld As Slide
    Dim oshp() As Shape
    Dim i As Integer
    Dim icount As Integer
    Dim sngAngle As Single
    On Error Resume Next
    Set osld = ActiveWindow.View.Slide
    If osld Is Nothing Then
        MsgBox "未选中页面", vbCritical
        Exit Sub
    End If
    If ActiveWindow.Selection.ShapeRange.Count > 0 Then ActiveWindow.Selection.Unselect
    icount = InputBox("输入等分的数量")
    sngAngle = 360 / icount
    ReDim oshp(1 To 1)
    For i = 1 To icount
        Set oshp(i) = osld.Shapes.AddShape(msoShapeBlockArc, _
            Left:=100, _
            Top:=100, _
            Width:=200, _
            Height:=200)
        oshp(i).Line.Visible = msoFalse
        If i / 2 = i \ 2 Then oshp(i).Fill.ForeColor.RGB = vbRed Else _
           oshp(i).Fill.ForeColor.RGB = vbGreen
        oshp(i).Adjustments(3) = 0.05
        '这里的 0.05 是圆环厚度，可以自行修改'
        oshp(i).Adjustments(1) = 180 + ((i - 1) * sngAngle)
        oshp(i).Adjustments(2) = oshp(i).Adjustments(1) + sngAngle
        If oshp(i).Adjustments(1) > 360 Then _
           oshp(i).Adjustments(1) = oshp(i).Adjustments(1) - 360
        If oshp(i).Adjustments(2) > 360 Then _
           oshp(i).Adjustments(2) = oshp(i).Adjustments(2) - 360
        oshp(i).Select (msoFalse)
        ReDim Preserve oshp(1 To UBound(oshp) + 1)
        If i = icount And icount / 2 <> icount \ 2 Then _
           oshp(i).Fill.ForeColor.RGB = vbYellow
    Next
    ActiveWindow.Selection.ShapeRange.Group
End Sub
```