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

此代码隐藏除德国国旗外的所有国旗（形状）。
我有一个变量存储国家的短名称，如GER、NL等

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

'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

---

您可以循环所有形状并将所有形状设置为可见=假，然后只需将要查看的形状设置为真

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

---

比@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

---

将附加图像与工作表放在同一文件夹中。（抱歉，不是所有的标志都在那里）。将其命名为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

Sub addflag（）
静态标志，文件路径为字符串
如果flags=vbNullString，则
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”
如果结束
常数nr=13
常数nc=15
暗cll As范围
像形状一样暗淡
将ss变暗为字符串
尺寸xr、xc、pos、r、c与长度相同
作为变型的Dim vv
变光主任
主任=nr\2
offc=nc\2
对于Selection.Cells中的每个cll
vv=cll.值
如果是Application.WorksheetFunction.IsText（vv），则
ss=CStr（vv）
如果Len（ss）=2，则
pos=CLng（仪表（1，标志，ss，VBTEXTCOMPAGE））
如果位置为0，则
位置=（位置-2）\3
r=主任-（位置\nc）
c=关闭-（位置模块nc）
调试。打印ss、pos、r、c
与cll
暗w，h
w=宽度
h=.高度
设置sh=ActiveSheet.Shapes.AddPicture（文件路径、msoFalse、msoTrue、、左、、上、w、h）
与sh
.Top=cll.Top
.Left=cll.Left
.高度=h
.宽度=w
.Placement=xlMoveAndSize
带有.PictureFormat.Crop
.PictureWidth=nc*w
.图片高度=nr*h
.PictureOffsetX=c*w
.PictureOffsetY=r*h
以
以
以
如果结束
如果结束
如果结束
下一个
端接头

---

您可以将这些stataments包装在一个环中。感谢您的回复，听起来它几乎可以完成任务。我是否能够以某种方式将我希望看到的形状的名称作为变量？假设我有一个变量：flagname，我可以插入它而不是“GermanyRecommensions”，以便根据变量的值显示正确的标志吗？啊，我现在明白了，我将立即测试它，非常感谢！您的代码不会隐藏除必需国家/地区之外的可见标志（如果已经可见）。@shrivallabha.redij您测试过吗？糟糕，我没有看到布尔参数

（shp.Name=strCountry）

@shrivallabha.redij；）@Moosli总是有一条捷径：）