Excel - Autoshape从单元格（值）获取它的名称

Question

我会尝试解释这个

我的VBA基于在表格中选择的值 TEXT ，您可以选择形状（如圆形，三角形，方形）和形状编号（1.2.3）当你双击它时会立即转到下一张名为 shapes 的表单，并根据你选择的值找到该形状

示例：工作表 TEXT 在单元格 K13 下拉框中选择圈 单元格 L13 在投递箱选择号 1 中。 然后双击J13并根据K13和L13进入工作表 SHAPES 并选择名称为 Circle1

的形状

这很好用，因为每个形状名称（如circle1，circle2，triangle1，traingle2，square1，square2）都匹配您可以从形状列表中选择的所有组合。

问题：如果我出于某种原因想要在圆圈，三角形，quare中更改名称，请说回家，公寓，商店...然后VBA找不到这个名字我必须更改所有形状的名称以匹配新名称....

解决方案：我需要的是所有形状都会自动更改它的名称，以便圆圈更改为主页等等。所有圆圈都将更改为主页......

实际上每个形状都是从特定细胞中寻找它的名字...... 例如：circle1使用它的名字来自B9 + C9，circle2 B9 + C10，triangle1 B10 + C9，triangle2 B10 + C10，square1 B11 + C9，square2 B11 + C10 ..所以如果B9中的圆变为home所有圆形名称将改为家，如home1，home2。

行 - 列B形状 - 列C编号

第9行 - 圈次 - 1

第10行 - 三角形 - 2

row11 - Square - 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

End Sub

谢谢

Answer 1

您可以运行这样的代码。我的代码（xl2010）假设你插入了这些形状的标准

• 自动形状“Oval”中的圆圈
• 自动形状“矩形”
的正方形
• 来自自动形状“Isosceles Triangle”的三角形

代码查看A8：C11中的主范围，我从示例中扩展了1列以提供a 1）形状类型 2）形状编号 3）编号系统 （见下图）

运行时的代码查看工作表上的每个形状，测试它是圆形，方形还是矩形，在表格的第二列中查找名称，然后应用第三列中的位置编号（ 请注意，您可能需要添加更多数字并扩展此范围。）

所以下面的代码最多可以指定三个圆圈 首页1 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