如何根据变量中的名称选择形状？

Question

此代码隐藏除德国国旗(形状)以外的所有国家国旗(形状)。

我有一个变量来存储国家的短名称，如GER，NL等。

是否有一种方法可以使相应的标志可见，而不为每种情况创建多个true/false块？

'Show proper flag on list and charts
Worksheets("Recommendations").Shapes("GermanyRecommendations").Visible = True
Worksheets("Recommendations").Shapes("NetherlandsRecommendations").Visible = False
Worksheets("Recommendations").Shapes("AustriaRecommendations").Visible = False
Worksheets("Recommendations").Shapes("CzechRecommendations").Visible = False
Worksheets("Recommendations").Shapes("FranceRecommendations").Visible = False
Worksheets("Recommendations").Shapes("PolandRecommendations").Visible = False
Worksheets("Recommendations").Shapes("SlovakiaRecommendations").Visible = False
Worksheets("Recommendations").Shapes("RomaniaRecommendations").Visible = False
Worksheets("Recommendations").Shapes("SpainRecommendations").Visible = False
Worksheets("Recommendations").Shapes("BelgiumRecommendations").Visible = False
Worksheets("Recommendations").Shapes("HungaryRecommendations").Visible = False

Answer 1

比@Moosli的解决方案更简洁一点：

Sub SetFlagVisibility(strCountry As String)
    Dim shp As Shape
    For Each shp In Worksheets("Recommendations").Shapes
       shp.Visible = (shp.Name = strCountry)
    Next
End Sub

Answer 2

您可以循环所有形状并设置所有可见的形状= false，然后只需将希望看到的形状设置为True

Sub main ()
   Call setShapeVisible("GermanyRecommendations")
End Sub

Sub setShapeVisible(byVal strCountry as String)

Dim shp As Shape
For Each shp In Worksheets("Recommendations").Shapes
   shp.Visible = False
Next
Worksheets("Recommendations").Shapes(strCountry).Visible = True

End Sub

Answer 3

将附加的图像与工作表放在同一个文件夹中。(对不起，并不是所有的标志都在).Name it flags.png。在要显示标志的单元格中放置两个字母国家代码。选择单元格并调用此宏：

Sub addflag()
Static flags, filepath As String
If flags = vbNullString Then
flags = ":af:al:dz:ad:ao:ag:ar:am:au:at:az:bs:bh:bd:bb" & _
     ":by:be:bz:bj:bt:bo:ba:bw:br:bn:bg:bf:mm:bi:kh" & _
     ":cm:ca:cv:cf:td:cl:cn:co:km:cd:cg:cr:ci:hr:cu" & _
     ":cy:cz:dk:dj:dm:do:tl:ec:eg:sv:gq:er:ee:et:fj" & _
     ":fi:fr:ga:gm:ge:de:gh:gr:gd:gt:gn:gw:gy:ht:hn" & _
     ":hu:ic:in:id:ir:iq:ie:il:it:jm:jp:jo:kz:ke:ki" & _
     ":xk:kp:kr:kw:kg:la:lv:lb:ls:lr:ly:li:lt:lu:mk" & _
     ":mg:mw:my:mv:ml:mt:mh:mr:mu:mx:fm:md:mc:mn:me" & _
     ":ma:mz:na:nr:np:nl:nz:ni:ne:ng:no:om:pk:pw:pa" & _
     ":pg:py:pe:ph:pl:pt:qa:ro:ru:rw:kn:lc:vc:ws:sm" & _
     ":st:sa:sn:rs:sc:sl:sg:sk:si:sb:so:za:es:lk:ps" & _
     ":sr:sz:se:ch:sy:tw:tj:tz:th:tg:to:tt:tn:tr:tm" & _
     ":tv:ug:ua:ae:gb:us:uy:uz:vu:va:ve:vn:ye:zm:zw"
     filepath = Application.ActiveWorkbook.Path & "\flags.png"
End If
Const nr = 13
Const nc = 15
Dim cll As range

Dim sh As Shape
Dim ss As String
Dim xr, xc, pos, r, c  As Long
Dim vv As Variant

Dim offr, offc As Long
offr = nr \ 2
offc = nc \ 2

For Each cll In Selection.Cells
  vv = cll.Value
  If Application.WorksheetFunction.IsText(vv) Then
    ss = CStr(vv)
    If Len(ss) = 2 Then
      pos = CLng(InStr(1, flags, ss, vbTextCompare))
      If pos <> 0 Then
        pos = (pos - 2) \ 3
        r = offr - (pos \ nc)
        c = offc - (pos Mod nc)
        Debug.Print ss, pos, r, c
        With cll
          Dim w, h
          w = .Width
          h = .Height
          Set sh = ActiveSheet.Shapes.AddPicture(filepath, msoFalse, msoTrue, .Left, .Top, w, h)
          With sh
           .Top = cll.Top
           .Left = cll.Left
           .Height = h
           .Width = w
           .Placement = xlMoveAndSize
           With .PictureFormat.Crop
             .PictureWidth = nc * w
             .PictureHeight = nr * h
             .PictureOffsetX = c * w
             .PictureOffsetY = r * h
           End With
         End With
        End With
      End If
    End If
  End If
Next
End Sub

​

​