Excel - Autoshape 从单元格中获取其名称（值）

发布于 2024-12-11 03:04:58 字数 1470 浏览 0 评论 0原文

我将尝试解释这一点，

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

示例： 单元格中的工作表 TEXT K13 在下拉框中选择圆圈在下拉框中的单元格 L13 中，选择数字 1。然后双击 J13 并根据 K13 和 L13 转到工作表 SHAPES 并选择名称为 Circle1 的形状

这工作正常，因为每个形状名称（如circle1、circle2、三角形1、三角形2、方形1、方形2）匹配您可以从形状列表中选择的所有组合。

问题：如果我出于某种原因想要更改下拉框中的圆形、三角形、方形的名称比如说家、公寓、商店...然后 VBA 找不到这些名称，我必须更改所有形状的名称以匹配新名称...

解决方案：我需要的是所有形状都会自动更改其名称，因此如果圆形更改为 home 等...所有圆形都会更改为 home...

实际上每个形状都从特定单元格中查找其名称... 示例：circle1 使用 B9+C9、circle2 B9+C10、triangle1 B10+C9、triangle2 B10+C10、square1 B11+C9、square2 B11+C10.. 中的名称。因此，如果将 B9 中的 Circle 更改为所有圆形形状名称将更改为 home，如 home1、home2。

rows -B 列形状 - C 列编号

row9 - 圆形 - 1

row10 - 三角形 - 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

结束子

谢谢

原文

I will try to explain this

I have VBA that based on value selected in sheet called TEXT you can select shape (like Circle, triangle, square) and shape number (1.2.3) and when you double click it immediately goes to next sheet called shapes and find that shape based on values you selected

Example: sheet TEXT in Cell K13 in drop-box select circle
in cell L13 in drop-box select number 1.
then double click in J13 and based on K13 and L13 it goes to sheet SHAPES and select shape that has name Circle1

This works fine because each shapes name (like circle1, circle2, triangle1, traingle2, square1, square2) match all combination that you can select from shape list ..

Problem: If I for some reason want to change names in drop-box from circle, triangle, quare to let say home, apartment, shop... then VBA can't find that names and I have to change names for all shapes to match new names....

Solution: What I need is that all shapes automatically change it's name so if Circle is changed to home etc.. all circle will change to home...

actually each shape looking for it's name from specific cells...
example: circle1 uses it's name from B9+C9, circle2 B9+C10, triangle1 B10+C9, triangle2 B10+C10, square1 B11+C9, square2 B11+C10.. so if circle in B9 is changed to home all circle shape names will change to home, like home1, home2.

rows -column B shape - Column C number

row9 - Circle - 1

row10 - Triangle - 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

Thank you

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

后eg是否自 2024-12-18 03:04:58

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

来自自动形状“椭圆形”的圆形
来自自动形状“矩形”的
正方形来自自动形状“等腰三角形”的三角形

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

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

因此，下面的代码最多将三个圆圈命名为
主页1
主页2
home3

最多三个方块为
方格1
方2
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

在此处输入图像描述

You could run code like this. My code (xl2010) assumes that you inserted these shape tyoes

Circle from the autoshape "Oval"
Square from the autoshape "Rectangle"
Triangle from the autoshape "Isosceles Triangle"

The code looks at a master range in A8:C11 that I expanded by 1 column form your example to provide a
1) Shape type
2) Shape number
3) Numbering system
(see pic below)

The code when run looks at each shape on the sheet, tests if it is a circle, square or rectangle, looks up the name in the second column of the table, then applies the number of the position in the third column (note that you may need to add more numbers and extend this range).

So the code below names up to three circles as
home1
home2
home3

up to three squares as
square1
square2
square3

etc

You could either run this code when you wanted to manually, or run it automatically with events each time a cell in the name ranging table changes, or when you activtated this sheets 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

enter image description here