vba 将形状添加到范围（.AddShape 方法）
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/18794259/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Add shape to range (.AddShape method)
提问by Aaron Thomas
For Excel-2007:
对于 Excel-2007：
Without using select, what is the best way to add a shape to a specific range or cell?
在不使用选择的情况下，将形状添加到特定范围或单元格的最佳方法是什么？
So far the best way I've found is by calculating using EntireColumn.Leftand the like.
到目前为止，我发现的最好方法是计算 usingEntireColumn.Left等。
Can the AddShapemethod be used within a range to automatically create a shape within the range? Or must AddShapealways locate a new shape relative to the upper-left corner of the document?
可以AddShape在范围内使用该方法自动创建范围内的形状吗？或者必须AddShape始终定位相对于文档左上角的新形状？
回答by Gary's Student
Here is an example of placing a Shape (in this case a TextBox) on a worksheet without any Selections or any references to the upper left-hand corner of the document, only the parameters of the range in question:
这是在工作表上放置 Shape（在本例中为 TextBox）的示例，没有任何Selection或对文档左上角的任何引用，只有相关范围的参数：
Sub CoverRange()
Dim r As Range
Dim L As Long, T As Long, W As Long, H As Long
Set r = Range("A2:H8")
L = r.Left
T = r.Top
W = r.Width
H = r.Height
With ActiveSheet.Shapes
.AddTextbox(msoTextOrientationHorizontal, L, T, W, H).TextFrame.Characters.Text = "Test Box"
End With
End Sub
回答by Aaron Thomas
I marked @Gary's Student's answer as the best... but since I had trouble finding much info that related to what I was doing, I thought some code pasting here might help someone in the future.
我将@Gary's Student 的答案标记为最好的……但是由于我无法找到与我正在做的事情相关的很多信息，因此我认为此处粘贴的一些代码可能会在将来对某人有所帮助。
The procedure @Gary's suggested can be adapted to cover a range of cells. I wanted to place a small shape on the right hand side of some cells in a range, that performed some functions on those cells. So, applying the .AddShapemethod:
@Gary 建议的程序可以适用于覆盖一系列单元格。我想在某个范围内的某些单元格的右侧放置一个小形状，在这些单元格上执行一些功能。因此，应用该.AddShape方法：
Dim cl As Range, rg As Range
Set rg = Range("J2", Range("J2").End(xlDown))
For Each cl In rg
With ActiveSheet.Shapes.AddShape(92, cl.Width - 10 + cl.Left, cl.Top + 5, 10, 10)
.OnAction = "click_pm_update"
.Name = cl.Row
.Shadow.Visible = False
End With
Next
This creates a small star to the right of each cell. The star's name reflects the row of that star, and when clicked it calls the "click_pm_update" procedure.
这会在每个单元格的右侧创建一个小星星。星星的名称反映了该星星所在的行，当点击它时，它会调用“click_pm_update”过程。
As a further note, click_pm_update uses the Application.Callermethod, combined with the shape's name (which reflects the row the shape is in), to determine what cells to act on:
进一步说明，click_pm_update 使用该Application.Caller方法，结合形状的名称（反映形状所在的行），以确定要对哪些单元格进行操作：
Private Sub click_pm_update()
Dim pmRow As String: pmRow = ActiveSheet.Shapes(Application.Caller).Name
'etc, etc
See herefor some useful info on the Application.Callermethod.
有关该方法的一些有用信息，请参见此处Application.Caller。
The beauty of this is that the spreadsheet can continue to be used as normal until the user clicks on the shape. This adds a lot of customization to the spreadsheet.
这样做的好处是电子表格可以继续正常使用，直到用户点击形状。这为电子表格添加了大量自定义。
