如何选择名称中带有特定单词的所有形状

问题描述 投票：0回答：4

我想选择并隐藏名称中含有特定单词的形状。

我正在使用 Excel 制作地图。

我有一个宏，可以在地图的右上角插入一个图钉/新形状，然后将其拖动到地图中的正确位置。

宏为每个新引脚/形状赋予新名称。
例如A23_AXR42_Towncar
A23 是形状的顺序（即这是插入的第 23 个形状）
AXR42是车的id号
Towncar属于类别

总共有七类引脚。
将添加新的引脚。
我需要选择一张纸中名称中包含“Towncar”一词的所有形状。因此，当我单击按钮时，它会选择所有形状，然后使用窗格窗口隐藏/显示它们。

我通过选择名称中包含某个单词的所有形状来录制宏。
问题是它根据名称选择所有形状。
我需要它来选择名称中包含“towncar”的所有形状。

Sub Select_towncar_shapes()
'
' Select_towncar_shapes Makro
'

'
    ActiveSheet.Shapes.Range(Array("A19_XRT44_Towncar")).Select
    ActiveSheet.Shapes.Range(Array("A19_XRT44_Towncar", "A23_ZWE18_Towncar")). _
        Select
    ActiveSheet.Shapes.Range(Array("A19_XRT44_Towncar", "A23_ZWE18_Towncar", _
        "A20_VBV77_Towncar")).Select
    ActiveSheet.Shapes.Range(Array("A19_XRT44_Towncar", "A23_ZWE18_Towncar", _
        "A20_VBV77_Towncar", "A24_RTC53_Towncar")).Select
    ActiveSheet.Shapes.Range(Array("A24_RTC53_Towncar")).Visible = msoFalse
    ActiveSheet.Shapes.Range(Array("A23_ZWE18_Towncar")).Visible = msoFalse
    ActiveSheet.Shapes.Range(Array("A20_VBV77_Towncar")).Visible = msoFalse
    ActiveSheet.Shapes.Range(Array("A19_XRT44_Towncar")).Visible = msoFalse
    ActiveSheet.Shapes.Range(Array("A19_XRT44_Towncar")).Visible = msoTrue
    ActiveSheet.Shapes.Range(Array("A20_VBV77_Towncar")).Visible = msoTrue
    ActiveSheet.Shapes.Range(Array("A23_ZWE18_Towncar")).Visible = msoTrue
    ActiveSheet.Shapes.Range(Array("A24_RTC53_Towncar")).Visible = msoTrue
End Sub
excel vba select shapes
4个回答
3
投票

以下例程将显示或隐藏工作表中形状名称包含特定单词的所有形状。无需选择任何形状并手动设置可见性：

Sub ShowHideShapes(ws As Worksheet, word As String, show As Boolean)
    Dim sh As Shape
    For Each sh In ws.Shapes
        If InStr(1, sh.Name, word, vbTextCompare) > 0 Then
            sh.Visible = show
        End If
    Next
End Sub

现在在工作表上放置 2 个按钮，一个用于显示形状，一个用于隐藏形状。这个按钮的代码是

Sub buttonShow_click()
    ShowHideShapes ActiveSheet, "Towncar", True
End Sub

Sub buttonHide_click()
    ShowHideShapes ActiveSheet, "Towncar", False
End Sub

请注意，您还可以使用形状来执行宏，只需将它们放在工作表上，右键单击它并使用“分配宏”即可。

如果您想显示和隐藏具有不同名称的其他形状，只需将第二个参数从 

"Towncar"
更改为您想要显示或隐藏的任何形状。

2
投票

显示/隐藏形状

调用流程

Sub ShowTownCar()
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ShowHideShapes "TownCar", wb, "Sheet1"
End Sub

Sub HideTownCar()
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ShowHideShapes "TownCar", wb, "Sheet1", True
End Sub

被调用的过程（方法）

Sub ShowHideShapes( _
        ByVal EndsWith As String, _
        ByVal wb As Workbook, _
        Optional ByVal WorksheetName As String = "", _
        Optional ByVal DoHide As Boolean = False)
    
    Dim ws As Worksheet:
    If Len(WorksheetName) = 0 Then
        Set ws = wb.ActiveSheet
    Else
        Set ws = wb.Sheets(WorksheetName)
    End If
    
    Dim eLen As Long: eLen = Len(EndsWith)
    
    Dim dict As Object, shp As Shape, shpName As String, IsFirstFound As Boolean
    
    For Each shp In ws.Shapes
        shpName = shp.Name
        If Len(shpName) >= eLen Then
            If StrComp(Right(shp.Name, eLen), EndsWith, vbTextCompare) = 0 Then
                If Not IsFirstFound Then
                    Set dict = CreateObject("Scripting.Dictionary")
                    dict.CompareMode = vbTextCompare
                    IsFirstFound = True
                End If
                dict(shpName) = Empty
            End If
        End If
    Next shp
  
    If dict Is Nothing Then
        MsgBox "No shapes ending with """ & EndsWith & """ found.", _
            vbExclamation
        Exit Sub ' no shapes found
    End If
    
    ws.Shapes.Range(dict.Keys).Visible = Not DoHide

End Sub
1
投票

我让它尽可能简单。 最好给出名称作为参数，但对于初学者来说，这个更容易

Public Sub SelectShapesByName()
        Dim i As Long
        Dim f() As Variant, z As Long
        Dim StepField As Long
             Dim ws As Worksheet
        Set ws = ActiveSheet
        On Error GoTo errExit
        StepField = 5
        ReDim f(StepField)
        z = -1
        For i = 1 To ws.Shapes.Count
            On Error Resume Next
            If ws.Shapes(i).Type <> 4 Then
                If ws.Shapes(i).Name Like "*Towncar*" Then ' Here is the name
                    If Err.Number = 0 Then
                        z = z + 1
                        If z > StepField Then
                            StepField = StepField + 5
                            ReDim Preserve f(StepField)
                        End If
                        f(z) = i
                    End If
                End If
            End If
        Next i
    
    On Error GoTo errExit
    If z > -1 Then
        If UBound(f) <> z Then ReDim Preserve f(z)
        ws.Shapes.Range(f).Select
    End If
    Exit Sub
    errExit:
    End Sub
1
投票

试试这个：

Sub select_towncar_shapes()
  select_shapes "towncar"
End Sub

Sub hide_towncar_shapes()
  shapes_visibility "towncar", False
End Sub

Sub show_towncar_shapes()
  shapes_visibility "towncar", True
End Sub

Sub shapes_visibility(includedStr As String, is_visible As Boolean)
  Dim sht As Worksheet:         Set sht = ThisWorkbook.Sheets("Sheet3")
  Dim shapes_array() As String: shapes_array = get_shapes_array(sht, includedStr)
  
  On Error Resume Next
  sht.Shapes.Range(shapes_array).Visible = is_visible
End Sub

Sub select_shapes(includedStr As String)
  Dim sht As Worksheet:         Set sht = ThisWorkbook.Sheets("Sheet3")
  Dim shapes_array() As String: shapes_array = get_shapes_array(sht, includedStr)
  
  On Error Resume Next
  sht.Shapes.Range(shapes_array).Select
End Sub
 
Function get_shapes_array(sht As Worksheet, includedStr As String) As String()
  Dim shp As Shape
  Dim output() As String
  Dim arrayCount As Long
  
  For Each shp In sht.Shapes
    If InStr(1, shp.Name, includedStr, vbTextCompare) > 0 Then
      arrayCount = arrayCount + 1
      ReDim Preserve output(1 To arrayCount)
      output(arrayCount) = shp.Name
    End If
  Next shp
  get_shapes_array = output
End Function
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.