Excel-自选图形从单元格中获取其名称（值）

我会尽力解释这一点

我有一个VBA，它基于在名为文本的工作表中选择的值，您可以选择圆形、三角形、正方形和1.2.3号形状，当您双击它时，它会立即转到下一个名为形状的工作表，并根据您选择的值查找该形状

示例：下拉框中单元格K13中的图纸文本选择圆 在下拉框中的单元格L13中选择数字1。 然后双击J13，根据K13和L13进入板材形状并选择名称为Circle1的形状

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

问题：如果出于某种原因，我想把投递箱中的名字从圆圈、三角形、正方形改为家、公寓、商店。。。然后VBA找不到该名称，我必须更改所有形状的名称以匹配新名称

解决方案：我需要的是，所有形状都会自动更改其名称，所以如果圆被更改为“主”等。。所有的圆圈都将变为家

实际上，每个形状都从特定的单元格中寻找它的名称。。。 示例：circle1使用来自B9+C9、Circle2B9+C10、Triangle1B10+C9、Triangle2B10+C10、Square1B11+C9、Square2B11+C10的名称。。所以，如果将B9中的圆更改为home，则所有圆形状名称都将更改为home，如home1、home2

行-列B形状-列C编号

第9行-圆圈-1

第10行-三角形-2

第11行-正方形-3

端接头

---

谢谢

您可以这样运行代码。我的代码xl2010假设您插入了这些形状类型

自选形椭圆的圆 自选图形矩形的正方形 自形等腰三角形中的三角形 代码查看A8:C11中的主范围，我从示例中将其扩展了1列，以提供 1形状类型 2型数 3编号系统 见下图

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

下面的代码将最多三个圆圈命名为 家庭1 家庭2 家庭3

最多三个正方形，如图所示 平方1 平方2 平方3

等

您可以在需要手动运行此代码时运行此代码，也可以在名称范围表中的单元格每次更改时，或在激活此工作表时，自动运行此代码，并附带事件

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

---

谢谢你的回复。。。我尝试了这个VBA，我得到了错误。。。请检查此原始文件，如果您可以修改[单击此处获取*.xls][1]，如果您能理解更多内容，也可以修改这些图像：[单击获取图像1][2][1]：[2]：我尝试了此VBA，它可以工作。。。现在，我需要修改此VBA，以便仅使用具有不同名称的方块，并仅更新名称已更改的方块。我必须仅以home1、home2、office1、office2、stair1、stair2的方式使用方块。。如果用户将列表中的“家”更改为“建筑”，则只会更改具有该名称而不更改其他名称的正方形，以指示位置。。。？或仅更新形状的办公室到电梯。。这列A和形状可以删除，只留下B名称和C编号，因为我只使用正方形对不起，我不太了解VBA检查此图像谢谢如果你得到满意的答案，你应该接受它。看见

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