Code VBA sur excel 2007

Bonjour,

Mon code indique erreur je veux récupérer des données sur le cite météo ciel sur une année, j'ai écris ce code à l'aide du tutoriel mais il indique erreur, ma question est ou est l'erreur et suis-je bien partie dans ce code merci d'avance.

note :
Version 2007 à jour
u et la différence entre deux date dans exce

Private Sub CommandButton1_Click()
codepays = Feuil2.Cells(3, 2)
Datedébut = Feuil2.Cells(2, 3)
u = Feuil2.Cells(3, 4)
b = 10 + 10 * i
For i = 0 To u
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://freemeteo.fr" & codepays & "&md=0&ndate=" & Datedébut + i & "&lc=1" _
        , Destination:=Feuil2.Cells(1, 1 + b))
        .Name = "" & Datedébut + i & "&lc=1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("E10").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://freemeteo.fr" & codepays & "&md=0&ndate=" & Datedébut + i & "&lc=5" _
        , Destination:=Feuil2.Cells(5, 1 + b))
        .Name = "" & Datedébut + i & "&lc=5"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True

.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("I10").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://gq.freemeteo.com/" & codepays & "&md=0&ndate=" & Datedébut + i & "&lc=6" _
, Destination:=Feuil2.Cells(9, 1 + b))
.Name = "" & Datedébut + i & "&lc=6"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Next i

End Sub

7 réponses

  • Votes
  • Date
  • Date décroissante
  1. bonjour,

    ton erreur se situe en début de code :

    Private Sub CommandButton1_Click()
    codepays = Feuil2.Cells(3, 2)
    Datedébut = Feuil2.Cells(2, 3)
    u = Feuil2.Cells(3, 4)
    b = 10 + 10 * i
    For i = 0 To u

    i est égal à quoi????
    Si tu ne le définis pas i = rien
    donc quand tu fais b= 10+10* rien (valeur de i)==> il ne peut pas calculer.
    1. Re,

      Merci mélanie1324

      J'ai essayé de le définir mais bof pas grand chose je vais reformuler ma demande pour être plus clair parce que la je m'arrache les cheveux,

      Je suis un débutant en VBA mais je trouve cette outil super pratique dans la mesure ou il peut me faire gagner énormément de temps.

      Je voudrai récupérer des donné météo d'un peut partout dans le monde pour mon travaille, le problème et que le site en question propose la météo et la donné que je recherche jour en jour sur une seul page dans une année il y a 365 jour pas drôle surtout que je dois récupérer 3 donné donc 365 * 3 (AIE AIE), j'ai réussi avec les aides et les forums à écrire ça.

      Maintenant je voudrai répéter l'action jusqu'à une date défini dans une case Excel date de début / date de fin.

      Le site propose un code par ville et la date dans sont URL
      https://gq.freemeteo.com/

      "2309527" un code que je n'ai pas encore cerné mais il dépend lui aussi du lieu étudié

      "&lc=1" les donné 1 pour récupérer les températures 5 pour l'humidité et 6 pour la pression atmosphérique

      "648100" le code pays

      "01/01/2010" la date

      Je voudrais répéter l'action puis copié les valeurs sur la feuil2 en dessous de celle précédemment copié c'est-à-dire la case A51.

      Je pourrais ainsi récupérer les donné de Malabo comme celle de paris ou Marseille merci.

      D'après quelque recherche il faut utiliser la fonction FOR TO et NEXT mais je n'arrive à rein de concluant.
      Merci d'avance

      Voici mon code pour le moment

      Private Sub CommandButton1_Click()

      date_début = Feuil2.Cells(3, 2)
      Date_fin = Feuil2.Cells(4, 2)

      With ActiveSheet.QueryTables.Add(Connection:= _
      "URL;https://gq.freemeteo.com/" _
      , Destination:=Feuil1.Cells(10, 1))
      .Name = "2010&lc=1_1"
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "6"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
      End With
      With ActiveSheet.QueryTables.Add(Connection:= _
      "URL;https://gq.freemeteo.com/" _
      , Destination:=Feuil1.Cells(10, 5))
      .Name = "2010&lc=5_1"
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "6"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
      End With
      With ActiveSheet.QueryTables.Add(Connection:= _
      "URL;https://gq.freemeteo.com/" _
      , Destination:=Feuil1.Cells(10, 9))
      .Name = "2010&lc=6_1"
      .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "6"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
      End With

      Range("A10:L50").Copy Destination:=Sheets("Feuil2").Range("A10")
      Sheets("Feuil2").Range("A10").Insert Shift:=xlDown

      Sheets("Feuil1").Select
      Range("A10:L50").Select
      Application.CutCopyMode = False
      Selection.QueryTable.Delete
      Selection.QueryTable.Delete
      Selection.QueryTable.Delete
      Selection.ClearContents
      Sheets("Feuil2").Select

      End Sub
      1. Bonjour,

        Pour tout ton code, je ne le vérifie pas mais je t'instaure pour que ta macro fonctionne de ta date début à ta date fin.

        Private Sub CommandButton1_Click()

        date_début = Feuil2.Cells(3, 2)
        Date_fin = Feuil2.Cells(4, 2)

        do while date_début <=date_fin

        With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://gq.freemeteo.com/" _
        , Destination:=Feuil1.Cells(10, 1))
        .Name = "2010&lc=1_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        End With
        With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://gq.freemeteo.com/" _
        , Destination:=Feuil1.Cells(10, 5))
        .Name = "2010&lc=5_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        End With
        With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://gq.freemeteo.com/" _
        , Destination:=Feuil1.Cells(10, 9))
        .Name = "2010&lc=6_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "6"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        End With

        i=10
        Range("A10:L50").Copy
        Sheets("Feuil2").select
        cells(i,1).select
        Activesheet.paste

        Sheets("Feuil1").Select
        Range("A10:L50").Select
        Application.CutCopyMode = False
        Selection.QueryTable.Delete
        Selection.QueryTable.Delete
        Selection.QueryTable.Delete
        Selection.ClearContents
        Sheets("Feuil2").Select

        date_début = date_début+1
        i=i+41
        loop
        End Sub
        1. Re,

          Encore merci à toi pour ton aide, il plante sur

          cells(i,1).select

          La méthode sélect de la classe range a échoué

          Est-ce grave docteur ?
          1. remplaces cells(i,1).select
            par

            Sheets("Feuil2").Range("A" & i).Insert Shift:=xlDown

            et vois ce que ca donne
            1. j'ai fait une petite erreur, recopie ce code :

              Private Sub CommandButton1_Click()

              date_début = Feuil2.Cells(3, 2)
              Date_fin = Feuil2.Cells(4, 2)
              i=10

              do while date_début <=date_fin

              With ActiveSheet.QueryTables.Add(Connection:= _
              "URL;https://gq.freemeteo.com/" _
              , Destination:=Feuil1.Cells(10, 1))
              .Name = "2010&lc=1_1"
              .FieldNames = True
              .RowNumbers = False
              .FillAdjacentFormulas = False
              .PreserveFormatting = True
              .RefreshOnFileOpen = False
              .BackgroundQuery = True
              .RefreshStyle = xlInsertDeleteCells
              .SavePassword = False
              .SaveData = True
              .AdjustColumnWidth = True
              .RefreshPeriod = 0
              .WebSelectionType = xlSpecifiedTables
              .WebFormatting = xlWebFormattingNone
              .WebTables = "6"
              .WebPreFormattedTextToColumns = True
              .WebConsecutiveDelimitersAsOne = True
              .WebSingleBlockTextImport = False
              .WebDisableDateRecognition = False
              .WebDisableRedirections = False
              .Refresh BackgroundQuery:=False
              End With
              With ActiveSheet.QueryTables.Add(Connection:= _
              "URL;https://gq.freemeteo.com/" _
              , Destination:=Feuil1.Cells(10, 5))
              .Name = "2010&lc=5_1"
              .FieldNames = True
              .RowNumbers = False
              .FillAdjacentFormulas = False
              .PreserveFormatting = True
              .RefreshOnFileOpen = False
              .BackgroundQuery = True
              .RefreshStyle = xlInsertDeleteCells
              .SavePassword = False
              .SaveData = True
              .AdjustColumnWidth = True
              .RefreshPeriod = 0
              .WebSelectionType = xlSpecifiedTables
              .WebFormatting = xlWebFormattingNone
              .WebTables = "6"
              .WebPreFormattedTextToColumns = True
              .WebConsecutiveDelimitersAsOne = True
              .WebSingleBlockTextImport = False
              .WebDisableDateRecognition = False
              .WebDisableRedirections = False
              .Refresh BackgroundQuery:=False
              End With
              With ActiveSheet.QueryTables.Add(Connection:= _
              "URL;https://gq.freemeteo.com/" _
              , Destination:=Feuil1.Cells(10, 9))
              .Name = "2010&lc=6_1"
              .FieldNames = True
              .RowNumbers = False
              .FillAdjacentFormulas = False
              .PreserveFormatting = True
              .RefreshOnFileOpen = False
              .BackgroundQuery = True
              .RefreshStyle = xlInsertDeleteCells
              .SavePassword = False
              .SaveData = True
              .AdjustColumnWidth = True
              .RefreshPeriod = 0
              .WebSelectionType = xlSpecifiedTables
              .WebFormatting = xlWebFormattingNone
              .WebTables = "6"
              .WebPreFormattedTextToColumns = True
              .WebConsecutiveDelimitersAsOne = True
              .WebSingleBlockTextImport = False
              .WebDisableDateRecognition = False
              .WebDisableRedirections = False
              .Refresh BackgroundQuery:=False
              End With

              Range("A10:L50").Copy
              Sheets("Feuil2").Range("A" & i).Insert Shift:=xlDown

              Sheets("Feuil1").Select
              Range("A10:L50").Select
              Application.CutCopyMode = False
              Selection.QueryTable.Delete
              Selection.QueryTable.Delete
              Selection.QueryTable.Delete
              Selection.ClearContents
              Sheets("Feuil2").Select

              date_début = date_début+1
              i=i+41
              loop
              End Sub
          2. cela donne :

            "La plage de destination n'est pas dans la même que celle dans laquelle la table de requête est créée "
            1. je sèches parce que je vois pas ce qui lui plait pas.

              Car Range("A10:L50").Copy
              Sheets("Feuil2").Range("A" & i).Insert Shift:=xlDown

              ou sheets("Feuil2").select
              cells(i,1).select
              activesheet.paste

              Fonctionnent. Je comprends pas.