Excel - Autoshape 从单元格(值)中获取它的名称

Question

我将尝试解释这一点

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

示例 : 表 正文 在单元格 K13 在下拉框中选择 圈子
在单元格 L13 在下拉框中选择号码 1 .
然后双击 J13 并根据 K13 和 L13 转到工作表 形状 并选择名称为 的形状圈子1

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

问题 :如果我出于某种原因想将下拉框中的名称从圆形、三角形、方形更改为家、公寓、商店……那么 VBA 找不到这些名称，我必须更改所有形状的名称以匹配新名字……

解决方案 :我需要的是所有形状都会自动更改它的名称，所以如果 Circle 更改为 home 等。所有圆圈都会更改为 home ......

实际上每个形状都在从特定的单元格中寻找它的名字......
示例:circle1 使用它的名称 B9+C9、circle2 B9+C10、triangle1 B10+C9、triangle2 B10+C10、square1 B11+C9、square2 B11+C10.. 所以如果将 B9 中的 circle 更改为 home 所有圆形名称将更改为 home，如 home1、home2。

行 - B柱形 - C列编号

第 9 行 - 圈 - 1

第 10 行 - 三角 - 2

第 11 行 - 广场 - 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

结束子

谢谢

Answer 1

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

来自autoshape“椭圆”的圆圈

来自autoshape“矩形”的正方形

来自autoshape“等腰三角形”的三角形

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

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

所以下面的代码最多将三个圆圈命名为
首页1
主页2
主页3

最多三个正方形
广场1
广场2
正方形3

ETC

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

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