Excel中 - 自選圖形得到它的從細胞（值）名字

Question

我會盡量解釋這個

我有VBA，基於在紙張選擇的值稱爲TEXT您可以選擇形狀（如圓形，三角形，正方形）和形狀數（1.2.3），當你雙擊它立即轉到稱爲形狀下一張紙並發現基於值該形狀所選

例：片TEXT在細胞K13在下拉框中選擇圓 在下拉框中選擇數細胞L13。 在J13然後雙擊並基於K13和L13它去片SHAPES，並選擇具有名稱形狀CIRCLE1

這工作得很好，因爲每個形狀的名稱（如CIRCLE1，CIRCLE2，triangle1，traingle2，square1 ，square2）匹配你可以從形狀列表中選擇的所有組合。

問題：如果我由於某種原因想要從圓形， ...然後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列數

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 

末次

謝謝

Answer 1

你可以像這樣運行的代碼。我的代碼（xl2010）假設你插入這些形狀tyoes從自選圖形「橢圓形」

• 圈
• 從自選圖形「矩形」
• 從自選圖形三角「等腰三角形」

廣場

代碼看起來在A8一個主範圍：C11我膨脹由1列形成您的示例，以提供 1）形狀類型 2）形狀數 3）編號系統 （見PIC b elow）

運行時的代碼查看錶單上的每個形狀，測試它是圓形，方形還是長方形，在表格的第二列中查找名稱，然後應用位於第三列（請注意，您可能需要添加更多數字並擴展此範圍）。

所以下面的名字代碼最多三個圓圈作爲 和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