简体   繁体   中英

Draw Shape Based on Cell Values

All,

I have code that creates a shape based on based on inputted values in the macro itself. I am wanting to have the values of shape type, width, and height specified by the user (location of shape on the sheet is indifferent to me right now). The user would input the aforementioned numerical values for width and height into the cells and click a button which would output the shape type and size the user wants.

In my case, there will be a drop down box for "rectangle" and "circle". I don't know how to get the code to read those words and convert it '1' and '9', respectively. I may just have the user choose 1 or 9 to create the shape.

I would also like to add text to the center of the shape. Again, I have created a code for this but it is within the macro. I would like to have the code reference a cell value instead. I assume it would be the same as above.

Thank you for any assistance.

Sub AddShape()

Dim s As Shape
Dim ws As Worksheet
Set ws = Sheets("Deck Layout")

'add a shape
Set s = ws.Shapes.AddShape(1, 80, 80, 75, 75)

'make it nearly white
s.Fill.ForeColor.RGB = RGB(245, 245, 255)

'show text within it
s.TextFrame.Characters.Text = "1"
s.TextFrame.Characters.Font.ColorIndex = 2

With s.TextFrame.Characters(0, 0)
s.TextFrame.HorizontalAlignment = xlHAlignCenter
s.TextFrame.VerticalAlignment = xlVAlignCenter
.Font.Color = RGB(0, 0, 0)

End With
End Sub

Since you've already got parts of the answer in the comments, I'll focus on the shape picking.
Have a look at this:

Dim ShapeType As MsoAutoShapeType

Select Case LCase(ws.Range("b1").Value)
    Case "rectangle"
        ShapeType = msoShapeRectangle
    Case "circle"
        ShapeType = msoShapeOval
End Select

Set s = ws.Shapes.AddShape(ShapeType, 80, 80, 75, 75)

It will find the value in B1, convert it to lower case and the test it for "rectangle" and "circle" and the set the ShapeType to a corresponding value.
You can use 1 and 9 instead, but that is bad practice. Use the defined constants - it will make your code much easier to read.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM