importer info Web en fonction du nom dans une cellule

Nougatine95 · 18 Juin 2016

Bonjour Amis du Forum,

Après moultes recherches infructueuses ou dont j'ai mal compris le contenu...
l'un d'entre vous peut-il m'éclairer sur le problème suivant:

J'ai des adresses url appelées à être souvent modifiées.
En A1, j'ai une adresse url, composée ainsi:
Ce lien n'existe plus

En C1, J'ai une autre adresse url, toujours composée de la même manière:
Ce lien n'existe plus

etc pour les cellules E1, G1, I1, etc... (donc une colonne sur deux)

Ce lien n'existe plus (écrit en A1) sera importé en A10
idem pour les autres : "Nom" en C1, sera importé en C10, etc...

J'ai enregistré la macro:

Code:

Sub Macro1()
'
' Macro1 Macro
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://NomDuSite/Util/det/50", Destination:=Range("$A$10"))
        .CommandType = 0
        .Name = "50"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Mon problème,
Comment automatiser, ne pas écrire pour chaque macro, le nom de l'URL, mais indiquer la cellule A1?
etc pour les macros suivantes.
Cellule A1 importera en A10
Cellule C1 importera en C10
etc

Merci pour votre aide.

david84 · 18 Juin 2016

Re : importer info Web en fonction du nom dans une cellule

Bonjour,

peut-être remplacer l'URL par =Range("$A$1").
S'il y a plusieurs cellules, utiliser une boucle du genre :

Code:

Dim URL As String, Dest As Range

For i = 1 To 10
  URL = Cells(1, i).Value
  Dest = Cells(10, i)

    With ActiveSheet.QueryTables.Add(Connection:= _
        URL, Destination:=Dest)
        .CommandType = 0
        .Name = "50"
        .FieldNames = True
        'suite du code
    End With

Next i

Code non testé puisque pas d'URL communiqué.

A+

Nougatine95 · 18 Juin 2016

Re : importer info Web en fonction du nom dans une cellule

Merci david84.

Voici petit fichier joint,
et le code enregistré pour ce fichier et dont je ne sais quoi faire.

Sub Macro1()
'
' Macro1 Macro
'

'
Range("A1").Select
Selection.Copy
Range("A10").Select
ActiveWorkbook.Queries.Add Name:="Notre choix (4)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""http://www.zeturf.fr/fr/programmes-et-pronostics/course?id=177355""))," & Chr(13) & "" & Chr(10) & " Data2 = Source{2}[Data]," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.TransformColumnTypes(Data2,{{""Column1"", type text}, {""Column2"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
Sheets.Add After:=ActiveSheet
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Notre choix (4)""" _
, Destination:=Range("$A$10")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Notre choix (4)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.ListObject.DisplayName = "Notre_choix__4"
.Refresh BackgroundQuery:=False
End With
End Sub
Application.CutCopyMode = False
End Sub

david84 · 18 Juin 2016

Re : importer info Web en fonction du nom dans une cellule

En partant du code que tu as fourni :
- créer une feuille nommée "Feuil2".
- la feuille comportant les URL est nommée "Feuil1".

A tester :

Code:

Sub Requete()

Dim i As Byte
Dim URL As String, Dest As Range


Worksheets("Feuil2").UsedRange.ClearContents 'on efface les données de la feuille 2

For i = 1 To 18 Step 2
  URL = Worksheets("Feuil1").Cells(1, i).Value ': Debug.Print URL
  Set Dest = Worksheets("Feuil2").Cells(10, i) ': Debug.Print Dest.Address

    With Worksheets("Feuil2").QueryTables.Add(Connection:= _
        "URL;" & URL & "", _
        Destination:=Dest)
        '.CommandType = 0
        .Name = "50"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    DoEvents
Next i
End Sub

Les résultats doivent être sur la feuille 2.

A+

Nougatine95 · 18 Juin 2016

Re : importer info Web en fonction du nom dans une cellule

david84,

Formidable, fooormidable !

Merci !

importer info Web en fonction du nom dans une cellule

Nougatine95

XLDnaute Occasionnel

david84

XLDnaute Barbatruc

Nougatine95

XLDnaute Occasionnel

Pièces jointes

david84

XLDnaute Barbatruc

Nougatine95

XLDnaute Occasionnel

Discussions similaires