时间戳

首页 > 解决方案 > Vba中的着色圈

excel - Vba中的着色圈

问题描述

我是 Vba 新手，我必须绘制以下颜色填充的圆圈

1/4色圆、半色圆、3/4色圆

我知道我可以使用以下代码绘制一个充满颜色的圆圈

 Set shpOval = ActiveSheet.Shapes.AddShape(msoShapeOval, curCellLeft, curCellTop, 20, 20)
 shpOval.Fill.ForeColor.RGB = RGB(128, 0, 0)

上面的代码给了我一个全彩色的圆圈，我必须改变这个属性才能得到我上面提到的圆形。

标签： excelvba

解决方案

只是为了好玩：玩 PIE-Shapes。

Sub DrawCircle(pieces As Integer, size As Double, position As Range, color)
        
    If pieces < 1 Then pieces = 1
    If pieces > 4 Then pieces = 4
    Dim varShape() As String
    ReDim shapeNames(0 To pieces - 1)
    
    Dim i As Long
    For i = 0 To pieces - 1
        Dim sh As Shape
        Dim x As Double, y As Double
        x = position.Left + IIf(i = 1 Or i = 2, size, 0)
        y = position.Top + IIf(i >= 2, size, 0)
        
        Set sh = position.Parent.Shapes.AddShape(msoShapePieWedge, x, y, size, size)
        shapeNames(i) = sh.Name
        sh.Rotation = i * 90
        If IsArray(color) Then
            sh.Fill.ForeColor.RGB = color(i + LBound(color))
        Else
            sh.Fill.ForeColor.RGB = color
        End If
        sh.Line.Visible = False
    Next i

    If pieces > 1 Then
        position.Parent.Shapes.Range(shapeNames).Group
    End If
End Sub

玩它：

Sub test()
    Call DrawCircle(3, 20, ActiveCell, vbRed)
    Call DrawCircle(4, 10, ThisWorkbook.Sheets(1).Range("F3"), Array(vbYellow, vbYellow, vbBlue, vbYellow))
    Call DrawCircle(1, 40, ActiveCell.Offset(2, 2), vbGreen)
End Sub

推荐阅读