Discussion :

[Roumégas]

Bonjour,

Je cherche à intégrer dans une macro Excel une formule qui permette d’automatiser la copie de pages web.

Je suis en train de récupérer des données mises en ligne par le ministère des finances concernant les comptes de gestion des communes. Les adresses sont sur ce modèle : http://alize2.finances.gouv.fr/commu...&exercice=2005
Dans cet exemple, c’est la commune n°109 du département 30 (Euzet dans le Gard, pour ceux qui connaissent…) et les chiffres de l’année 2005. Les adresses étant toutes sur le même modèle, c’est assez simple de les générer automatiquement.

J’ai donc créé des tableaux avec 8 colonnes : dans la première, un identifiant qui me permet de reconnaître la commune puis 7 colonnes avec les adresses des comptes de 2005 à 2011 :
| cod30109 | http:/….2005 | http:/….2006 | http:/….2007 (etc…)
Avec autant de lignes que de communes à saisir (pour le département du Gard il y en a 356)

Voici ma macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Selection.Copy
    Range("B1").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Range("C1").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Range("D1").Select    
    (Etc jusqu’à la case H1)

Donc la macro supprime la première ligne, copie mon identifiant puis ouvre successivement les 7 pages. Après ça, il ne me reste plus qu’à faire CTRL A, CTRL C, CTRL W, 7 fois très vite (je suis en train de devenir le karaté kid du clavier) puis à coller tout dans une feuille. Une autre macro permet de récupérer les données en créant une ligne dans un tableau et il ne reste plus qu’à recommencer.

Ce que je n’ai pas réussit à faire, c’est à intercaler une formule qui, après avoir ouvert une page web, la copie puis la referme. Ce qui me permettrait d’arrêter de faire le couillon avec mon clavier.

Pardon pour les approximations…
Merci pour votre aide

[Invité]

Bonjour,

Ma réponse ne cadre pas avec votre demande, mais vous pouvez également récupérer une page Web sous forme de classeur avec le code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub TransformerUneFeuilleWebEnClasseur()
 
Dim Obk As Workbook
 
 
        Set Obk = Workbooks.Open("http://www....")
 
        Obk.Activate
 
        ' Suppression des liens hypertextes
        '----------------------------------
        Cells.Hyperlinks.Delete
 
        ' Suppression des images et contrôles
        '------------------------------------
        ActiveSheet.Shapes.SelectAll
        Selection.Delete
 
        'Sauvegarde sur le disque dur
        '----------------------------
 
        'Travail comme un classeur
        '-------------------------
 
          Set Obk = Nothing
 
End Sub

En créant un objet Worksheet en plus dans OBk, je pense que vous pourriez sans doute alimenter votre classeur avec chacune des feuilles.

Cordialement.

[Docmarti]

Obtenir des données externes à partir d'une page Web


http://office.microsoft.com/fr-ca/ex...010218472.aspx

[Roumégas]

Merci beaucoup pour votre aide.

En fait, ce que je recherche est un peu différent :
Je n'ai pas besoin de créer une extraction avec mise à jour automatisée, le nombre de pages est trop grand (36000 communes X 7 années) et elles ne sont de toute façon jamais remises à jour.

Ce que je veux faire, c'est un copier-coller "de base", sachant que quand la manip est faite et que les données ont été intégrées dans mon tableau, plus besoin d'y revenir.

Ce que je n'arrive pas à faire, c'est demander à la macro de copier un élément qui n'est pas dans excel mais sur une page web.

Est-ce que ça vous paraît possible (ou faut-il revoir toute la démarche...) ?

Merci pour vos réponses

[Invité]

Bonjour,

C'est ce que fait la macro TransformerUneFeuilleWebEnClasseur.

Vous appelez la page Web et vous récupérez un classeur à partir duquel vous pourrez récupérer ce que vous voulez.

Cordialement.

[Roumégas]

Merci Eric pour ta réponse

Désolé d'être un peu dépassé, mais je navigue à vue : pour moi, la programmation ou le russe, c'est kifkif (encore que le russe...)

Donc voici le type de code qu'il faudrait que j'insère :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
With ActiveSheet.QueryTables.Add(Connection:= _
 "URL;http://alize2.finances.gouv.fr/communes/eneuro/detail.php?icom=014&dep=011&type=BPS&param=0&exercice=2006", _
 Destination:=Range("a1"))
 
 .BackgroundQuery = True
 .TablesOnlyFromHTML = True
 .Refresh BackgroundQuery:=False
 .SaveData = True
 End With

Ici, c'est la page d'Armissan dans l'Aude, budget 2006.

Maintenant, voici ce que je ne sais pas faire (merci de ne pas rire...) : ne pas avoir à inscrire l'adresse dans la macro, mais renvoyer une adresse qui est inscrite dans une case de mon fichier Excel...

[Docmarti]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub Macro3()
 
    Dim url As String
 
    Set ListeDesUrl = ThisWorkbook.Worksheets("Feuil1")
 
    wb = ThisWorkbook.Name
    ws = "Feuil3"
 
    Set DestSheet = ThisWorkbook.Worksheets(ws)
 
    For i = 1 To 36000
 
        url = "URL;" & ListeDesUrl.Cells(i, 1).Value
 
        'Par exemple, la cellule A1 de feuil1 contient :
        'http://alize2.finances.gouv.fr/communes/eneuro/detail.php?icom=014&dep=011&type=BPS&param=0&exercice=2006
 
        nom = "Query" & i
 
        If Trim(ListeDesUrl.Cells(i, 1).Value) = "" Then
            Stop
        Else
 
            DestSheet.Cells.Clear
 
            ThisWorkbook.Activate
            ThisWorkbook.Worksheets(ws).Activate
 
            For Each QT In DestSheet.QueryTables ' ActiveSheet.QueryTables
                QT.Delete
            Next QT
 
            Set QT = DestSheet.QueryTables.Add(Connection:=url, Destination:=DestSheet.Range("A1"))
 
            With DestSheet.QueryTables.Add(Connection:=url, _
                Destination:=Workbooks(wb).Worksheets(ws).Range("A1"))
                .Name = nom
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = False
                .RefreshOnFileOpen = False
                .BackgroundQuery = False 'True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = False 'True
                .RefreshPeriod = 0
                .WebSelectionType = xlEntirePage
                .WebFormatting = xlWebFormattingAll
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            For Each QT In DestSheet.QueryTables
                QT.Delete
            Next QT
        End If
 
       ' DestSheet.Range("E5").Select
 
    Next
 
End Sub

[Roumégas]

Super merci Docmati !

J'ai donc un fichier avec une colonne d'adresses en feuil1. La macro ouvre la 1e adresse, copie la page, la colle en feuil3, nettoie la feuil3 puis recommence avec la 2e adresse et ainsi de suite.

Maintenant, juste avant que la macro nettoie la feuil3, je voudrai récupérer les données pour les mettre dans un tableau. J'ai fait comme ceci : en feuil2, je reprends les données de la feuil3 dont j'ai besoin en les disposant en ligne. Il faut que la macro copie cette ligne et la colle (coller valeurs) en feuil4, en intercalant une nouvelle ligne à chaque fois. C'est à dire ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sheets("Feuil2").Select
    Range("A1:X1").Select
    Selection.Copy
    Sheets("Feuil4").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown

J'ai essayé d'intercaler cette séquence dans la macro de Docmarti, mais ça marche pas (j'ai un message d'erreur "400"). Soit je trouve pas le bon endroit de la macro, soit c'est pas la bonne démarche...

[Docmarti]

Commence par enlever les SELECT pour plutôt indiquer explicitement
les noms des feuilles, puis dis-nous sur quelle ligne se produit l'erreur 400:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Copier()
On Error GoTo errorhandler
     Sheets("Feuil2").Range("A1:X1").Copy
    Sheets("Feuil4").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Application.CutCopyMode = False
    Sheets("Feuil4").Rows("1:1").Insert Shift:=xlDown
  Exit Sub
  Resume
errorhandler:
  MsgBox Error
 
End Sub

[Roumégas]

Voilà, ça marche en insérant la formule corrigée par Docmarti.
Alélouia ! Hosana ! Docmarti hou akbar !