XL 2021 Récupérer info météo

let
    Ville = Excel.CurrentWorkbook(){[Name="MaVille"]}[Content]{0}[Column1],
    Source = Json.Document(Web.Contents("https://geo.api.gouv.fr/communes?nom=" & Ville)),
    #"Converti en table" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error),
    #"Column1 développé" = Table.ExpandRecordColumn(#"Converti en table", "Column1", {"nom", "code", "codeDepartement", "siren", "codeEpci", "codeRegion", "codesPostaux", "population", "_score"}),
    #"Valeurs extraites" = Table.TransformColumns(#"Column1 développé", {"codesPostaux", each Text.Combine(List.Transform(_, Text.From), ","), type text})
in
    #"Valeurs extraites"

Sub Add_ConnectionDM(sReq, sName)
Dim wb As Workbook
Dim wq As WorkbookQuery
Dim bExists As Boolean
Dim vbAnswer As VbMsgBoxResult
Dim vbDataModel As VbMsgBoxResult
    Set wb = ActiveWorkbook
        bExists = False
        For Each wq In wb.Queries
          If wq.Name = sName Then
            bExists = True
          End If
        Next wq
        ''Add to Data Model if it does not exist
        If bExists = False Then
            wb.Connections.Add2 Name:=sName, _
                                Description:="Connection to the '" & sReq & "' query in the workbook.", _
                                ConnectionString:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & sReq & ";Extended Properties=", _
                                CommandText:="" & sReq & "", _
                                lCmdtype:=6, _
                                CreateModelConnection:=True, _
                                ImportRelationships:=False
  
        End If
End Sub

Sub TestAddConnectionDM()
     Add_ConnectionDM "Requête1", "CodeINSEE"
End Sub

Sub SupprimerConnexion()
ActiveWorkbook.Connections("codeINSEE").Delete
End Sub

Sub GetPQResult(sName)
    Dim oConn As WorkbookConnection, oRS As Object ' Recordset
    Dim oCnn As Object, sTabName As String
    Set oConn = ThisWorkbook.Connections(sName)
    sTabName = oConn.ModelTables(1).Name
    Set oCnn = ThisWorkbook.Model.DataModelConnection.modelConnection.ADOConnection
    Set oRS = CreateObject("ADODB.RecordSet")
    oRS.Open "EVALUATE '" & sTabName & "'", oCnn
    Do While Not oRS.EOF
        Debug.Print "Ville: " & oRS.Fields(sTabName & "[nom]") & _
                    " - Code INSEE: " & oRS.Fields(sTabName & "[code]") & _
                    " - Dep: " & oRS.Fields(sTabName & "[codeDepartement]") & _
                    " - Cp: " & oRS.Fields(sTabName & "[codesPostaux]") & _
                    " - Pop: " & oRS.Fields(sTabName & "[population]")
        oRS.MoveNext
    Loop
End Sub


Sub TestGetPQResult()
  GetPQResult "codeINSEE"
End Sub

Sub RecupCodeInsee(commune)
    Dim http As Object, res As Object, elem
    Const BaseURL = "https://geo.api.gouv.fr/communes?nom="
    Set http = CreateObject("MSXML2.XMLHTTP")
    UrL = BaseURL & commune
    On Error Resume Next
    With http
        .Open "GET", UrL, False
        .Send
        Set res = JsonConverter.ParseJSON(.responseText)
    End With
    For Each elem In res
       Forme.Lb_Result.AddItem elem("nom") & " -> Code INSEE: " & elem("code") & _
                               " - Dep: " & elem("codeDepartement") & _
                               " - Cp: " & JoinC(elem("codesPostaux"), ", ") & _
                               " - Pop: " & elem("population")
       If elem("codesPostaux").Count > 5 Then
          Forme.Lb_Result.ColumnWidths = Forme.Lb_Result.width + _
                   elem("codesPostaux").Count * 22
       End If
    Next
    Set http = Nothing
    Set res = Nothing
End Sub
Function JoinC(myCol, delimiter) As String
    Dim result  As Variant
    Dim cnt     As Long
    ReDim result(myCol.Count - 1)
    For cnt = 0 To myCol.Count - 1
        result(cnt) = CStr(myCol(cnt + 1))
    Next cnt
    JoinC = Join(result, delimiter)
End Function
Sub TestRecupCodeInsee()
    Forme.Show 0
    Forme.TB_Ville = "TestRecupCodeINSEE Paris"
    Forme.Lb_Result.Clear
    Forme.MultiPage1.Value = 2
    RecupCodeInsee "Paris"
End Sub

Private Sub TB_Ville_Change()
Dim t As String
t = TB_Ville
If Left(t, 1) = " " Then t = Mid(t, 2)
TB_Ville = UCase(Left(t, 1)) & Mid(t, 2)
End Sub

Private Sub Lb_Result_Click()
    Dim selectedItem As String
    Dim firstWord As String
    Dim firstSpacePos As Integer
    selectedItem = Lb_Result.Value
    firstSpacePos = InStr(1, selectedItem, " ")
    If firstSpacePos > 0 Then
        firstWord = Left(selectedItem, firstSpacePos - 1)
    Else
        firstWord = selectedItem
    End If
    TB_Ville.Value = firstWord
End Sub

Private Sub Lb_Result_Click()
    Dim selectedText As String
    Dim words() As String
    Dim fourthWord As String
    selectedText = Lb_Result.Value
    words = Split(selectedText, " ")
    If UBound(words) >= 4 Then
        fourthWord = words(4)
        TB_Ville = fourthWord
    End If
End Sub