Reputation: 191
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
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
Upvotes: 0
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
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