Sujet Précédent Sujet Suivant

Code VBA sur excel 2007

Fermé
medinio30 Messages postés 6 Date d'inscription mercredi 19 janvier 2011 Statut Membre Dernière intervention 12 novembre 2012 - 18 juil. 2011 à 17:26
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 - 19 juil. 2011 à 16:54
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




A voir également:

7 réponses

Réponse 1 / 7
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
19 juil. 2011 à 13:29
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.
0
Réponse 2 / 7
medinio30 Messages postés 6 Date d'inscription mercredi 19 janvier 2011 Statut Membre Dernière intervention 12 novembre 2012
19 juil. 2011 à 15:40
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
0
Réponse 3 / 7
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
19 juil. 2011 à 15:50
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
0
Réponse 4 / 7
medinio30 Messages postés 6 Date d'inscription mercredi 19 janvier 2011 Statut Membre Dernière intervention 12 novembre 2012
19 juil. 2011 à 16:31
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 ?
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
19 juil. 2011 à 16:38
remplaces cells(i,1).select
par

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

et vois ce que ca donne
0
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
19 juil. 2011 à 16:43
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
0
Réponse 6 / 7
medinio30 Messages postés 6 Date d'inscription mercredi 19 janvier 2011 Statut Membre Dernière intervention 12 novembre 2012
19 juil. 2011 à 16:52
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 "
0
Réponse 7 / 7
melanie1324 Messages postés 1504 Date d'inscription vendredi 25 mai 2007 Statut Membre Dernière intervention 31 janvier 2018 154
19 juil. 2011 à 16:54
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.
0