Nationalflaggen

.. das wohl mächtigste Werkzeug in Bill Gates' Büro-Sippe. Ob reine Formeln, PowerQuery oder VBA. Hier bleiben kaum Wünsche unerfüllt.
Benutzeravatar
thowe
Beiträge: 196
Registriert: 12. Sep 2022, 16:57
Hat sich bedankt: 78 Mal
Danksagung erhalten: 67 Mal
Kontaktdaten:

Re: Nationalflaggen

#11

Beitrag von thowe »

Hallöchen xlKing!

Danke für deine Meinung.

Der Pfad mit SVG vorgehen ist für mich unumstößlich!
Der Merhwert kann sein:

- eine tabellarische Übersicht aller Länder, deren Flagge man in einer Zelle darstellen kann (deine 1. Vorgehensweise).
- ein Language Handling zumindest deutsch, englisch kann man einbauen
- Das Erstellen kann man mit einer UDF (die hast du mit deiner Sub Test(), eigentlich - eh - schon umgesetzt) anbieten.
zB mit CreateFlagInCell("A1", Austria, [ratio], [true])
-> 1. Option das Seitenverhältnis (default 3:2 (?),
-> 2. Option Anpassen der Zellenhöhe und Zellenbreite an die Größe der erstellten Flagge
- da wie du angemerkt hast Excel - eigentlich- eine XML Sache ist, kann man das erstellen der Flagge als Shape anbieten
-> im Grunde gleich wie vorher, nur andere UDF zB mit CreateFlagAsShape()
- die Farbwerte der Flaggen können zusätlich als RGB, HEX zur Verfügung gestellt werden
- Man kann die Flagge als Hintergrund in einer Zelle, oder in einem Zellbereich verwenden
- Zusätzlich kann man (zum Beispiel wenn als Hintergrund verwendet) die Flagge (muss denke ich mir, dann ein Shape sein, transparent darstellen
-> zB (ungeprüft mit: Shape.PictureFormat.TransparentBackground = msoTrue & mit ... .TransparencyColor = RGB)

---------------------------

Etwas anders wird es, wenn man die Nationalflaggen wie beispielsweise für Schweiz, Spanien haben möchte. Die kann man nur als Shape anbieten.

---------------------------

Wer kann soetwas gebrauchen, wenn man - eh - das gratis runterladen kann?

- Ein Anwender möchte die Flagge nicht als Shape haben, sondern - eben - als Zellhintergrund (oder hat diese Möglichkeit nicht gekannt!)
- Ein Anwender möchte Flaggen verwenden, sich aber nicht krumm suchen, skalieren etc....
- Wer ist nun ein Anwender?
- all jene, die irgendwelche tabellarischen Übersichten basten, erstellen für:
- diverse multinationale Sportevents
- Autoren & Bücher
- Musiker
- Filme
- Rezepte
- Unternehmen,
- Top/Flop in with
- jeder Controller in multinational tätigen Unternehmen, die neben SAP oder anderem ERP Excel verwenden. Denn sonst wäre er kein Controller ;-)
- ...

die warum auch immer Excel als Framwork verwenden.

lg
Benutzeravatar
d'r Bastler
Beiträge: 670
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 175 Mal
Danksagung erhalten: 90 Mal

Re: Nationalflaggen

#12

Beitrag von d'r Bastler »

Moin allerseits,

stur -wie ich eben bin- gehe ich dann mal meinen Weg mit Flaggen klauen -> für XL aufbereiten > anzeigen. Mit diesem Neunzeiler habe ich schon mal die Links zu allen 194 Wimpeln auf meinem PC (X: ist mein XL-Laufwerk auf meinem lokalen Server), allerdings mit Unmengen Unrat drumherum.

Code: Alles auswählen

Option Explicit
Sub GetFlags()
Dim xmlhttp As New MSXML2.XMLHTTP60 'setzt die Verweise 'Microsoft HTML Object Library' & 'Microsoft XML, v6.0' voraus
    xmlhttp.Open "POST", "https://de.wikipedia.org/wiki/Liste_der_Nationalflaggen", False 'POST ist stabiler als GET, schneller und ignoriert den Cache, ist also tatsächlich aktuell
    xmlhttp.send
    Open "x:\flags I.txt" For Output As #1
        Print #1, xmlhttp.responseText
    Close #1
End Sub
Nächster Schritt, den Code so filtern, dass tatsächlich nur Links übrig bleiben. Und ob dann noch IV-konvertiert werden muss, sehe ich dann.

CU soon
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Benutzeravatar
d'r Bastler
Beiträge: 670
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 175 Mal
Danksagung erhalten: 90 Mal

Re: Nationalflaggen

#13

Beitrag von d'r Bastler »

Nur ein halber Schritt, aber immerhin habe ich aus dem großen Haufen Code jetzt mal nur die Zeile, die Links zu den Fähnchen enthalten. Die werden jetzt noch gründlich cropped.

Code: Alles auswählen

Sub GetLinkLines()
Dim sLine As String, i As Integer
Dim FSO As Object, TSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TSO = FSO.OpenTextFile("x:\flags.txt")
    Cells.Clear
    i = 1
Do While Not TSO.AtEndOfStream
   sLine = TSO.ReadLine
   If InStr(sLine, "svg.png") Then
      Cells(i, 1) = sLine
      i = i + 1
  End If
Loop
TSO.Close

End Sub
Keep on VBAsteling ;)
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Benutzeravatar
d'r Bastler
Beiträge: 670
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 175 Mal
Danksagung erhalten: 90 Mal

Re: Nationalflaggen

#14

Beitrag von d'r Bastler »

So und nun der nächste Schritt: Wir bauen uns den Link zum Fähnchen auf Wikipedia:

Code: Alles auswählen

Sub FilterLinks()
Dim i As Integer, iLeft As Integer, iLen As Integer
Dim sLine As String

i = 1
'Filtern nach Flag_
Do While Cells(i, 1) <> ""
    sLine = Cells(i, 1)
    iLen = Len(sLine)
    iLeft = InStrRev(sLine, "Flag_")
    Cells(i, 2) = iLeft
    Cells(i, 3) = Right(sLine, (iLen - iLeft) + 1)
    i = i + 1
Loop
'Trimmen nach .svg
i = 1
Do While Cells(i, 1) <> ""
    sLine = Cells(i, 3)
    iLen = Len(sLine)
    iLeft = InStr(sLine, "svg")
    'Cells(i, 2) = iLeft
    Cells(i, 3) = Left(sLine, iLeft + 2)
    i = i + 1
Loop
'VBAsteln des Links zu Wikipedia
i = 1
Do While Cells(i, 1) <> ""
    sLine = Cells(i, 3)
    Cells(i, 1) = "https://de.wikipedia.org/wiki/Datei:" & sLine
    Cells(i, 2).Clear
    Cells(i, 3).Clear
    i = i + 1
Loop

End Sub
Leider stelle ich eben fest, das die Links jeweils nur auf eine Seite führen, die zwar den Wimpel zeigt, aber immer noch mit viel Unrat kontaminiert ist. Und die Grafiken sind hinter wechselnden Pfaden versteckt, deren Logik ich nicht erkenne. Dann versuche ich das Ganze noch mal über die von xlKing (warum muss ich bei dem Namen immer an Burger/Pommes/Cola denken? ;) ) vorgeschlagene Quelle. Nachtrag: Habe eben noch eine Seite gefunden, wo es vielleicht sogar einfacher ist. Mal sehen.

Grüße
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Benutzeravatar
d'r Bastler
Beiträge: 670
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 175 Mal
Danksagung erhalten: 90 Mal

Re: Nationalflaggen

#15

Beitrag von d'r Bastler »

Moin allerseits,
meine neue Fähnchenquelle macht es mir einerseits schwer, die Links aus dem HTML-Code zu extrahieren, andererseits aber leicht die Links selbst zu basteln: Die Namenskonvention der Grafiken folgt dem Muster TLD & "-flag.gif" Das dürfte der einfachste Weg zum Flaggenklau sein ;)
Grüße
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Benutzeravatar
thowe
Beiträge: 196
Registriert: 12. Sep 2022, 16:57
Hat sich bedankt: 78 Mal
Danksagung erhalten: 67 Mal
Kontaktdaten:

Re: Nationalflaggen

#16

Beitrag von thowe »

Hallöchen Heb

also deine Sub GetFlags() macht bei mir rein gar nichts....
Die Zieldatei bleibt immer leer.
Ist auch egal ob überhaupt die Datei existiert. läuft durch ohne zu rückeln...

edit(1):
habe mir einfach mal den Quelltext der Site kopiert und so in die .txt kopiert...
edit(2):
Da gibt es Kollationsprobleme, die sind aber nicht - wirklich - relevant

lg
Benutzeravatar
d'r Bastler
Beiträge: 670
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 175 Mal
Danksagung erhalten: 90 Mal

Re: Nationalflaggen

#17

Beitrag von d'r Bastler »

Moin allerseits, und thowe im Besonderen,

nämlich als Danke für's testen.

Mit meinen VBAsteleien bin ich inzwischen auf einem völlig anderen Dampfer: Ich hole mir eine Liste der TLD dieser Welt von Wikipedia. Die kommt mit vier Spalten von denen nur die erste gebraucht wird. Also erst einmal aufräumen. Dazu gehört leider auch, dass so manche verbundene (igitt!) Zelle bereinigt werden muss. Als Ergebnis dieser Handarbeit bleibt eine Spalte mit TLDs.

Als kleiner Helfer: Der Shape-Killer

Code: Alles auswählen

Sub TearOffFlags()
Dim shp As Shape

For Each shp In ActiveSheet.Shapes
    Application.DisplayAlerts = False
    shp.Delete
Next
End Sub
Das zweite Snippet macht aus den TLDs Links:

Code: Alles auswählen

Sub MakeLinks()
Dim i As Integer, c As Integer
i = 1
For c = 2 To 4
Columns(c).ClearContents
Columns(c).ClearContents
Next c
Do While Cells(i, 1) <> ""
    Cells(i, 1) = Trim(Cells(i, 1))     'beseitigt Leerzeichen aus der TLD-Liste von Wikipedia
    Cells(i, 2) = "https://www.worldometers.info/img/flags/" & Right(Cells(i, 1), 2) & "-flag.gif"
    i = i + 1
Loop
End Sub
Das dritte holt sich die Fähnchen:

Code: Alles auswählen

Sub ShowFlags()
Dim shp As Shape, sLink As String, rTarget As Range
Dim i As Integer
i = 1
Do While Cells(i, 1) <> ""
    Set rTarget = Cells(i, 3)
    rTarget.RowHeight = 40
    sLink = Cells(i, 2)
    On Error Resume Next
    Set shp = ActiveSheet.Shapes.AddPicture(sLink, msoTrue, msoTrue, rTarget.Left, rTarget.Top, rTarget.Width, rTarget.Height)
    i = i + 1
    Application.StatusBar = i & " flags imported"
Loop
Application.StatusBar = False
End Sub
Das dauert (bei mir) gute zwei Minuten (auch manchmal mit einer Fehlermeldung, es sind nicht allen TLDs tatsächlich Fahnen zugeordnet), man kann aber in der Statusbar sehen, dass sich brav etwas tut. Und dann hat man alle verfügbaren Wimpel in Spalte 3

In zwei Minuten habe ich ja noch nicht mal das austro-vulkanische Bicolor (Zeile 14) nachgebaut ;-)

Kleiner Nachsatz: Ich hoffe, dass die Betreiber der Website nicht irgendwann den Hahn zudrehen und automatisierte Downloads unterbinden...

Viel Spaß damit! Grüße und Danke für die lustige Idee!
Folgende Benutzer bedankten sich beim Autor d'r Bastler für den Beitrag:
thowe
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Benutzeravatar
thowe
Beiträge: 196
Registriert: 12. Sep 2022, 16:57
Hat sich bedankt: 78 Mal
Danksagung erhalten: 67 Mal
Kontaktdaten:

Re: Nationalflaggen

#18

Beitrag von thowe »

Hallöchen Heb,

danke für deine VBAstelei.

Jetzt bleibe ich stur...!

Wikipedia "liefert" für 194 Länder die Flaggen. Als .svg. Das ist besser, glaube mir und xlKing!
Es scheint auch bei worldometer das Seitenverhältnis nicht ganz korrekt berückscihtigt worden zu sein.
Daher bleibe ich als Quelle bei Wikipedia.

Leider habe ich noch andere Dinge zu tun, werde aber zeitnah meinen Vorschlag hier posten.

LG
Benutzeravatar
thowe
Beiträge: 196
Registriert: 12. Sep 2022, 16:57
Hat sich bedankt: 78 Mal
Danksagung erhalten: 67 Mal
Kontaktdaten:

Re: Nationalflaggen - Korrektur!

#19

Beitrag von thowe »

zu #16
also deine Sub GetFlags() macht bei mir rein gar nichts....
Die Zieldatei bleibt immer leer.
Ist auch egal ob überhaupt die Datei existiert. läuft durch ohne zu rückeln...
STIMMT NICHT!

Ich war immer zu ungeduldig, Datei mit Inhalt wird erstellt
Benutzeravatar
d'r Bastler
Beiträge: 670
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 175 Mal
Danksagung erhalten: 90 Mal

Re: Nationalflaggen

#20

Beitrag von d'r Bastler »

Moin thowe,

das mit Deiner Sturheit werde ich gerne unterstützen ;) Deine Wahl der Quelle Wikipedia (wkp) ist vom Ergebnis her sicher besser als worldometers. Schon alleine mal weil .svg statt .gif (also beliebig skalierbar) und natürlich vollständiger.

Allerdings ist die Extraktion der Wimpel auf wkp erheblich aufwändiger, weil gleich mehrere HTML-Ebenen gefiltert werden müssen. Und zudem bleibt eben das Problem, dass wkp Pfade nach einem von mir noch nicht verstandenen System baut. Da sind noch viele Nüsse zu knacken.

Mal schauen, vielleicht gibt's andere Quellen, die leichter anzuzapfen, aber dennoch qualitativ hochwertig sind. Die jeweils notwendigen Techniken habe ich ja schon beschrieben.

Schönen Am'd noch!
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365
Antworten

Wer ist online?

Mitglieder in diesem Forum: Ahrefs [Bot] und 0 Gäste