Conditions <linestring> xlsx to kml

Bonjour à tous,

je dispose de ce code (grace à Steelson, merci à lui ) pour générer des liaisons entre un point A et un point B sur GE depuis excel

chaque liaison et les coordonnées associées sont sur une même ligne

les points A ont leurs CG en colonne DM

les points B ont leurs CG en colonne DN

les CG du parcours sont en colonnes DO et DP

Je cherche à intégrer des conditions qui permettent de changer la couleur de la ligne du parcours en fonction de la valeur texte de ma colonne AJ

exemple : si AJ contient "bleu" alors la ligne du parcours sera bleu, si rouge, si vert, si orange

voici le code actuel :

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Const SW_SHOWNORMAL = 1

Sub tracer()
Dim i

    Open Application.ActiveWorkbook.Path & "\adrien83000.kml" For Output As #1

    ' en-tete
    Print #1, "<?xml version=""1.0"" encoding=""UTF-8""?><kml xmlns=""http://www.opengis.net/kml/2.2"" xmlns:gx=""http://www.google.com/kml/ext/2.2"" xmlns:kml=""http://www.opengis.net/kml/2.2"" xmlns:atom=""http://www.w3.org/2005/Atom""><Document>"
    Print #1, "<name><![CDATA[adrien83000]]></name><open>1</open><description><![CDATA[excel to kml]]></description>"
    Print #1, "<Style id=""lignerouge""><LineStyle><color>ff0000ff</color><width>2</width></LineStyle></Style>"

    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

        ' depart
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DR").Value + "]]></name><description><![CDATA[" + Cells(i, "BB").Value + "]]></description><Point><coordinates>"
        Print #1, Cells(i, "DM").Value
        Print #1, "</coordinates></Point></Placemark>"

        ' arrivee
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DS").Value + "]]></name><description><![CDATA[" + Cells(i, "BC").Value + "]]></description><Point><coordinates>"
        Print #1, Cells(i, "DN").Value
        Print #1, "</coordinates></Point></Placemark>"

        ' parcours
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DQ").Value + "]]></name><visibility>1</visibility><description><![CDATA[" + Cells(i, "AB").Value + "]]></description><styleUrl>#lignerouge</styleUrl><LineString><tessellate>1</tessellate><altitudeMode>relative</altitudeMode><coordinates>"
        Print #1, Cells(i, "DO").Value
        Print #1, Cells(i, "DP").Value
        Print #1, "</coordinates></LineString></Placemark>"

    Next

' fin
    Print #1, "</Document></kml>"
    Close #1

' lancement

    ShellExecute 0, "open", Application.ActiveWorkbook.Path & "\adrien83000.kml", vbNullString, Application.ActiveWorkbook.Path, SW_SHOWNORMAL

End Sub

par avance merci pour vos idées et conseils

cordialement

Adrien

bonjour à tous,

alors, j'ai réussi ce que je voulais faire, avec la fonction If, Then, Elself, mais vu que c'était trop beau pour etre vrai, mes instructions 1,2,3,4 affichent bien les tracés de parcours mais avec une opacité de 0%. Seule l’instruction 5 (else) par defaut (style id=""lignerouge"") apparaitre avec une opacité de 100%....

ai je fais une erreur dans mon code??

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Const SW_SHOWNORMAL = 1

Sub tracer()
Dim i

    Open Application.ActiveWorkbook.Path & "\adrien83000.kml" For Output As #1

    ' en-tete
    Print #1, "<?xml version=""1.0"" encoding=""UTF-8""?><kml xmlns=""http://www.opengis.net/kml/2.2"" xmlns:gx=""http://www.google.com/kml/ext/2.2"" xmlns:kml=""http://www.opengis.net/kml/2.2"" xmlns:atom=""http://www.w3.org/2005/Atom""><Document>"
    Print #1, "<name><![CDATA[adrien83000]]></name><open>1</open><description><![CDATA[excel to kml]]></description>"
    Print #1, "<Style id=""lignerouge""><LineStyle><color>ff0000ff</color><width>2</width></LineStyle></Style>"
    Print #1, "<Style id=""ligneverte""><LineStyle><color>00ff00ff</color><width>2</width></LineStyle></Style>"
    Print #1, "<Style id=""lignebleue""><LineStyle><color>0000ffff</color><width>2</width></LineStyle></Style>"

    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

        ' depart
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DR").Value + "]]></name><description><![CDATA[" + Cells(i, "BB").Value + "]]></description><Point><coordinates>"
        Print #1, Cells(i, "DM").Value
        Print #1, "</coordinates></Point></Placemark>"

        ' arrivee
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DS").Value + "]]></name><description><![CDATA[" + Cells(i, "BC").Value + "]]></description><Point><coordinates>"
        Print #1, Cells(i, "DN").Value
        Print #1, "</coordinates></Point></Placemark>"

        ' parcours
        If Cells(i, "AJ").Value = "ON AIR" Then ' => SI condition 1 validée ALORS
        'Instructions 1
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DQ").Value + "]]></name><visibility>1</visibility><description><![CDATA[" + Cells(i, "AB").Value + "]]></description><styleUrl>#ligneverte</styleUrl><LineString><tessellate>1</tessellate><altitudeMode>relative</altitudeMode><coordinates>"
        Print #1, Cells(i, "DO").Value
        Print #1, Cells(i, "DP").Value
        Print #1, "</coordinates></LineString></Placemark>"

        ElseIf Cells(i, "AJ").Value = "GO OT" Then ' => SINON, SI condition 2 validée ALORS
        'Instructions 2
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DQ").Value + "]]></name><visibility>1</visibility><description><![CDATA[" + Cells(i, "AB").Value + "]]></description><styleUrl>#lignebleue</styleUrl><LineString><tessellate>1</tessellate><altitudeMode>relative</altitudeMode><coordinates>"
        Print #1, Cells(i, "DO").Value
        Print #1, Cells(i, "DP").Value
        Print #1, "</coordinates></LineString></Placemark>"

        ElseIf Cells(i, "AJ").Value = "GO SURVEY" Then ' => SINON, SI condition 3 validée ALORS
        'Instructions 3
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DQ").Value + "]]></name><visibility>1</visibility><description><![CDATA[" + Cells(i, "AB").Value + "]]></description><styleUrl>#lignebleue</styleUrl><LineString><tessellate>1</tessellate><altitudeMode>relative</altitudeMode><coordinates>"
        Print #1, Cells(i, "DO").Value
        Print #1, Cells(i, "DP").Value
        Print #1, "</coordinates></LineString></Placemark>"

        ElseIf Cells(i, "AJ").Value = "GO LOS" Then ' => SINON, SI condition 4 validée ALORS
        'Instructions 4
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DQ").Value + "]]></name><visibility>1</visibility><description><![CDATA[" + Cells(i, "AB").Value + "]]></description><styleUrl>#lignebleue</styleUrl><LineString><tessellate>1</tessellate><altitudeMode>relative</altitudeMode><coordinates>"
        Print #1, Cells(i, "DO").Value
        Print #1, Cells(i, "DP").Value
        Print #1, "</coordinates></LineString></Placemark>"

        Else ' => SINON
        'Instructions 5
        Print #1, "<Placemark><name><![CDATA[" + Cells(i, "DQ").Value + "]]></name><visibility>1</visibility><description><![CDATA[" + Cells(i, "AB").Value + "]]></description><styleUrl>#lignerouge</styleUrl><LineString><tessellate>1</tessellate><altitudeMode>relative</altitudeMode><coordinates>"
        Print #1, Cells(i, "DO").Value
        Print #1, Cells(i, "DP").Value
        Print #1, "</coordinates></LineString></Placemark>"

        End If

    Next

' fin
    Print #1, "</Document></kml>"
    Close #1

' lancement

    ShellExecute 0, "open", Application.ActiveWorkbook.Path & "\adrien83000.kml", vbNullString, Application.ActiveWorkbook.Path, SW_SHOWNORMAL

End Sub

trouvé ! le code Hex défini aussi l'opacité...

Rechercher des sujets similaires à "conditions linestring xlsx kml"