根据单元格值绘制形状
Draw Shape Based on Cell Values
全部,
我有代码根据宏本身的输入值创建形状。我想要用户指定的形状类型、宽度和高度的值(sheet 上的形状位置现在对我来说无关紧要)。用户将上述宽度和高度的数值输入到单元格中,然后单击一个按钮,该按钮将输出用户想要的形状类型和大小。
在我的例子中,"rectangle" 和 "circle" 会有一个下拉框。我不知道如何获取代码来读取这些单词并将其分别转换为“1”和“9”。我可能只是让用户选择 1 或 9 来创建形状。
我还想在形状的中心添加文字。同样,我为此创建了一个代码,但它在宏中。我想让代码引用一个单元格值。我想它会和上面一样。
感谢您的帮助。
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
既然你已经在评论中得到了部分答案,我将重点介绍形状选择。
看看这个:
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)
它将在 B1 中找到值,将其转换为小写并测试 "rectangle" 和 "circle" 并将 ShapeType 设置为相应的值。
您可以改用 1 和 9,但这是不好的做法。使用定义的常量 - 这将使您的代码更易于阅读。
全部,
我有代码根据宏本身的输入值创建形状。我想要用户指定的形状类型、宽度和高度的值(sheet 上的形状位置现在对我来说无关紧要)。用户将上述宽度和高度的数值输入到单元格中,然后单击一个按钮,该按钮将输出用户想要的形状类型和大小。
在我的例子中,"rectangle" 和 "circle" 会有一个下拉框。我不知道如何获取代码来读取这些单词并将其分别转换为“1”和“9”。我可能只是让用户选择 1 或 9 来创建形状。
我还想在形状的中心添加文字。同样,我为此创建了一个代码,但它在宏中。我想让代码引用一个单元格值。我想它会和上面一样。
感谢您的帮助。
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
既然你已经在评论中得到了部分答案,我将重点介绍形状选择。
看看这个:
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)
它将在 B1 中找到值,将其转换为小写并测试 "rectangle" 和 "circle" 并将 ShapeType 设置为相应的值。
您可以改用 1 和 9,但这是不好的做法。使用定义的常量 - 这将使您的代码更易于阅读。