isic5
isic5

Reputation: 191

How to choose shape depending on name in variable?

This code hides all country flags (shapes) except the German one.
I have a variable that stores the country shortname such as GER, NL etc.

Is there a way to have the corresponding flag visible without creating multiple true/false blocks for each case?

'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

Upvotes: 0

Views: 268

Answers (3)

Antoni Gual Via
Antoni Gual Via

Reputation: 763

Put the attached image in the same folder as your sheet. (Sorry, not all flags are there).Name it flags.png. Put two letter country codes in the cells where the flags are to be displayed. Select the cells and call this macro:

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

flags spritesheet

Upvotes: 0

Moosli
Moosli

Reputation: 3285

you can loop all Shapes and set all Shapes Visible = false and after that just set the shape you want to see to 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

Upvotes: 2

JohnyL
JohnyL

Reputation: 7152

A bit concise than @Moosli's solution:

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

Upvotes: 7

Related Questions