CODEWITHSUNDEEP
excelvba
manu197a
manu197a

Reputation: 110

How can you draw a "pie" of shapes of equal degrees?

How can you draw a "pie" of shapes of equal degrees?

This code creates the arcs in the current worksheet --

Sub Create_arcs()

Dim MyShape As Shape

'Your number of parts in the circle
NumParts = 6

For i = 1 To NumParts

    Set MyShape = ActiveSheet.Shapes.AddShape(msoShapeBlockArc, 0.75, 0.75, 146.25, 146.25)
    With MyShape

        .Adjustments.Item(1) = i * 360 / NumParts
        .Adjustments.Item(2) = i * 360 / NumParts + 360 / NumParts
        'Size of internal doughnut
        '.Adjustments.Item(3) = .2

        'Format for each sharpe
        .Fill.ForeColor.RGB = RGB(i * 20, i * 20, i * 20)
        .Line.ForeColor.RGB = RGB(255, 255, 255)
        .Line.Weight = 3

    End With

Next i

End Sub

This works in Excel and can be adjusted to work in PowerPoint and, I guess, Word.

Suggestions on how to do this more efficienty are accepted.

Upvotes: 1

Views: 643

Answers (2)

manu197a
manu197a

Reputation: 110

I modified the code a litle to add a second set of arcs in order to give some kind of shadow effect. The final result (after modifying the colors) is shown in the image.

Sub Create_arcs()

Dim MyShape As Shape
Dim NumParts  As Long
Dim Percentage_internal As Double
Dim Big_circles  As Long
Dim Small_circles As Long
Dim Internal_circle As Long
Dim Big_start As Long
Dim Small_start As Long
Dim Internal_start As Long

Dim My_start As Double
Dim iterator As Long

NumParts = 5

Percentage_internal = 0.08

Big_circles = 500
Small_circles = Big_circles - (Big_circles * (Percentage_internal)) * 2
Internal_circle = Small_circles - (Small_circles * (Percentage_internal + 0.1)) * 2

Big_start = 1
Small_start = Big_start + (Big_circles / 2) - (Small_circles / 2)
Internal_start = Big_start + (Big_circles / 2) - (Internal_circle / 2)

My_start = 180

For iterator = 1 To NumParts

    Set MyShape = ActiveSheet.Shapes.AddShape(msoShapeBlockArc, Big_start, Big_start, Big_circles, Big_circles)
    With MyShape

        .Adjustments.Item(1) = My_start
        .Adjustments.Item(2) = My_start + 360 / NumParts
        .Adjustments.Item(3) = Percentage_internal

        'Format for each sharpe
        .Fill.ForeColor.RGB = RGB(iterator * 45, iterator * 45, iterator * 45)
        .Line.ForeColor.RGB = RGB(255, 255, 255)
        .Line.Weight = 3

        My_start = My_start + 360 / NumParts

    End With

Next iterator

For iterator = 1 To NumParts

    Set MyShape = ActiveSheet.Shapes.AddShape(msoShapeBlockArc, Small_start, Small_start, Small_circles, Small_circles)
    With MyShape

        .Adjustments.Item(1) = My_start
        .Adjustments.Item(2) = My_start + 360 / NumParts
        .Adjustments.Item(3) = Percentage_internal

        'Format for each sharpe
        .Fill.ForeColor.RGB = RGB(iterator * 30, iterator * 30, iterator * 30)
        .Line.ForeColor.RGB = RGB(255, 255, 255)
        .Line.Weight = 3

        My_start = My_start + 360 / NumParts

    End With

Next iterator

Set MyShape = ActiveSheet.Shapes.AddShape(msoShapeOval, Internal_start, Internal_start, Internal_circle, Internal_circle)
With MyShape

    .Fill.ForeColor.RGB = RGB(200, 200, 200)
    .Line.ForeColor.RGB = RGB(255, 255, 255)
    .Line.Weight = 3

End With

End Sub

Final result

Upvotes: 0

AJD
AJD

Reputation: 2438

OR perhaps - with a little more thought and proper indenting:

Option Explicit ' <-- always remember this at the top of modules
Sub Create_arcs(numParts as Long)
Dim iterator as Long

    For iterator = 1 To numParts
        With ActiveSheet.Shapes.AddShape(msoShapeBlockArc, 0.75, 0.75, 146.25, 146.25)
            .Adjustments.Item(1) = iterator * 360 / NumParts
            .Adjustments.Item(2) = iterator * 360 / NumParts + 360 / NumParts
            'Size of internal doughnut
            '.Adjustments.Item(3) = .2

            'Format for each shape
            .Fill.ForeColor.RGB = RGB(iterator * 20, iterator * 20, iterator * 20)
            .Line.ForeColor.RGB = RGB(255, 255, 255)
            .Line.Weight = 3
        End With
    Next iterator
End Sub

Of course, I haven't tested it - and even the code above will break easily - what if you want 13 parts (hint: consider what code relies on the number of parts)? What are Items 1, 2 & 3? Perhaps some plain English will help.

So, how can you draw a "pie" of shapes of equal degrees?

Probably by setting up a pie chart with the required amount of data and letting the native functions deal with the problems.

Upvotes: 1

Related Questions