Excel – Autoshape从单元格获取它的名字（值）
我会尽力解释这一点
我有VBA基于名为TEXT的表中选定的值，您可以select形状 （如圆形，三angular形，正方形）和形状编号 （1.2.3），当您双击它立即去到下一张名为形状，并find该形状您select的值
示例 ：单元格K13中的文本框在投递箱select编号1的单元格L13中select圆圈 。 然后在J13中双击，然后基于K13和L13进入SHAPESgraphics并select名称为Circle1的形状
这可以正常工作，因为每个形状名称（如circle1，circle2，triangle1，traingle2，square1，square2）匹配所有可以从形状列表中select的组合。
问题 ：如果我由于某种原因想要在圆圈，三angular形的投箱中更改名称，让我们说，家，公寓，商店……那么VBA无法find这个名称，我必须更改所有形状的名称匹配新的名字….
解决scheme ：我需要的是所有的形状自动改变它的名字，所以如果圈改为家等..所有的圈子将改变为家…
例如：circle1使用它的名称从B9 + C9，circle2 B9 + C10，triangle1 B10 + C9，triangle2 B10 + C10，square1 B11 + C9，square2 B11 + C10 ..所以如果将B9中的圆圈更改为家，则所有的圆形名称将更改为home，如home1，home2。
行 – 列B的形状 – 列C的编号
row9 – Circle – 1
row10 – 三angular形 – 2
row11 – 方形 – 3
VBA Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim test As String If Not Intersect(Target, Range("J13:J16")) Is Nothing Then test = Target.Offset(, 1).Value & Target.Offset(, 2).Value Worksheets("Shapes").Shapes(CStr(test)).Select Worksheets("Shapes").Activate End If 结束小组
谢谢
你可以像这样运行代码。 我的代码（xl2010）假定你插入了这些形状tyoes
- 从自动形状“椭圆形”
- 方形从自定形“矩形”
- Autoshape“Isosceles Triangle”中的三angular形
代码查看A8：C11中的主范围，我将其扩展为1列，以提供1）形状types2）形状编号3）编号系统（请参见下图）
运行时的代码会查看表单上的每个形状，testing它是一个圆形，正方形还是矩形，在表格的第二列中查找名称，然后在第三列中应用位置编号（ 请注意，可能需要添加更多的数字并扩大这个范围）。
所以下面的代码最多可以命名为home1 home2 home3
多达三平方如square1 square2 square3
等等
你可以在你手动的时候运行这个代码，或者每次当名字范围表中的一个单元改变时，或者当你激活这些表
Sub ReName() Dim shp As Shape Dim rng1 As Range Dim lngCirc As Long Dim lngSq As Long Dim lngTri As Long Set rng1 = Sheets(1).Range("A8:C18") For Each shp In ActiveSheet.Shapes Select Case shp.AutoShapeType Case msoShapeOval lngCirc = lngCirc + 1 shp.Name = rng1.Cells(2, 2) & rng1.Cells(1, 3).Offset(lngCirc) Case msoShapeIsoscelesTriangle lngTri = lngTri + 1 shp.Name = rng1.Cells(3, 2) & rng1.Cells(1, 3).Offset(lngTri) Case msoShapeRectangle lngSq = lngSq + 1 shp.Name = rng1.Cells(4, 2) & rng1.Cells(1, 3).Offset(lngSq) Case Else Debug.Print "Check shape: " & shp.Name & " of " & shap.AutoShapeType End Select Next End Sub
