OVH Cloud OVH Cloud

Copies internet vers Excel

5 réponses
Avatar
M41
Bonjour

Ce programme ouvre une liste de pages internet correspondant à des codes
produits X.
Comment recopier les contenus (avec OnKey ?) ?
Comment fermer chaque page internet à partir d'Excel ?

Merci

M41



Option Base 0
Sub OuvrirToxicoCEE()
'
Dim X As Variant, i As Integer, T As String
X = Array("400-100-8", "400-010-9", "400-020-3", "400-030-8")
With Sheets("Feuil3").Range("A1")
T = "http://ecb.jrc.it/esis/"
.FormulaR1C1 = T
'.Hyperlinks(1).TextToDisplay = T
.Hyperlinks(1).Address = T
.Hyperlinks(1).ScreenTip = "Connexion CEE toxico !"
.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
With .Offset(1, 0)
For i = 0 To UBound(X, 1)
'2 possibilités OK
'T = "http://ecb.jrc.it/esis/index.php?GENRE=ECNO&ENTREE=" &
X(i)
T =
"http://ecb.jrc.it/esis-pgm/esis_reponse.php?LANG=en&GENRE=ECNO&ENTREE=" &
X(i) & "#"
.FormulaR1C1 = T
.Hyperlinks(1).Address = T
.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
'*******************************
'copier le contenu ?
'coller des pages dans Excel : en manuel la meilleure solution
'... semble avec le collage spécial en forme texte sur A1 en feuille
1
'fermer chaque page internet après copie ?
'*******************************
Next i
End With
.Offset(2, 0).Select
End With
End Sub

5 réponses

Avatar
h2so4
as-tu essayé un web query ?

"M41" wrote in message
news:4595c27a$0$27407$
Bonjour

Ce programme ouvre une liste de pages internet correspondant à des codes
produits X.
Comment recopier les contenus (avec OnKey ?) ?
Comment fermer chaque page internet à partir d'Excel ?

Merci

M41



Option Base 0
Sub OuvrirToxicoCEE()
'
Dim X As Variant, i As Integer, T As String
X = Array("400-100-8", "400-010-9", "400-020-3", "400-030-8")
With Sheets("Feuil3").Range("A1")
T = "http://ecb.jrc.it/esis/"
.FormulaR1C1 = T
'.Hyperlinks(1).TextToDisplay = T
.Hyperlinks(1).Address = T
.Hyperlinks(1).ScreenTip = "Connexion CEE toxico !"
.Hyperlinks(1).Follow NewWindow:úlse, AddHistory:=True
With .Offset(1, 0)
For i = 0 To UBound(X, 1)
'2 possibilités OK
'T = "http://ecb.jrc.it/esis/index.php?GENREìNO&ENTREE=" &
X(i)
T =
"http://ecb.jrc.it/esis-pgm/esis_reponse.php?LANG=en&GENREìNO&ENTREE=" &
X(i) & "#"
.FormulaR1C1 = T
.Hyperlinks(1).Address = T
.Hyperlinks(1).Follow NewWindow:úlse, AddHistory:=True
'*******************************
'copier le contenu ?
'coller des pages dans Excel : en manuel la meilleure solution
'... semble avec le collage spécial en forme texte sur A1 en
feuille 1
'fermer chaque page internet après copie ?
'*******************************
Next i
End With
.Offset(2, 0).Select
End With
End Sub




Avatar
h2so4
' par exemple :

Sub retrievedatafromtheWeb()

X = Array("400-100-8", "400-010-9", "400-020-3", "400-030-8")



For Each i In X
'lancer un query pour chaque produit i dans la liste X

With Sheets(1).QueryTables.Add(Connection:= _
"URL;http://ecb.jrc.it/esis-pgm/esis_reponse.php?LANG=en&GENREìNO&ENTREE="
& i _
, Destination:=Sheets(1).Range("A1"))
.Name = "esis_reponse.php?LANG=en&GENREìNO&ENTREE=" & i
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True

' ajouter les réponses dans de nouvelles colonnes
.RefreshStyle = xlInsertDeleteCells

.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone

' les données se trouvent dans le tableau 10 sur la page WEB
.WebTables = "10"

.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:úlse
End With
Next

"h2so4" wrote in message
news:L9Nlh.265837$
as-tu essayé un web query ?

"M41" wrote in message
news:4595c27a$0$27407$
Bonjour

Ce programme ouvre une liste de pages internet correspondant à des codes
produits X.
Comment recopier les contenus (avec OnKey ?) ?
Comment fermer chaque page internet à partir d'Excel ?

Merci

M41



Option Base 0
Sub OuvrirToxicoCEE()
'
Dim X As Variant, i As Integer, T As String
X = Array("400-100-8", "400-010-9", "400-020-3", "400-030-8")
With Sheets("Feuil3").Range("A1")
T = "http://ecb.jrc.it/esis/"
.FormulaR1C1 = T
'.Hyperlinks(1).TextToDisplay = T
.Hyperlinks(1).Address = T
.Hyperlinks(1).ScreenTip = "Connexion CEE toxico !"
.Hyperlinks(1).Follow NewWindow:úlse, AddHistory:=True
With .Offset(1, 0)
For i = 0 To UBound(X, 1)
'2 possibilités OK
'T = "http://ecb.jrc.it/esis/index.php?GENREìNO&ENTREE=" &
X(i)
T =
"http://ecb.jrc.it/esis-pgm/esis_reponse.php?LANG=en&GENREìNO&ENTREE="
& X(i) & "#"
.FormulaR1C1 = T
.Hyperlinks(1).Address = T
.Hyperlinks(1).Follow NewWindow:úlse, AddHistory:=True
'*******************************
'copier le contenu ?
'coller des pages dans Excel : en manuel la meilleure solution
'... semble avec le collage spécial en forme texte sur A1 en
feuille 1
'fermer chaque page internet après copie ?
'*******************************
Next i
End With
.Offset(2, 0).Select
End With
End Sub








Avatar
M41
Bonsoir H2SO4, un pseudo prédestiné à la toxico corrosive

J'avais, depuis mon message, utilisé QueryTables à force de tout essayer
avec l'enregistreur de macro automatique.
On ne trouve pas beaucoup d'informations sur les paramètres de cette
fonction : y en a t il de facilement disponibles ?
Actuellement ma macro fonctionne très bien, bien que très légèrement
différente de celle proposée.
Je n'utilise pas .WebTables mais ajoute "_1" à la fin de la ligne .Name !!!
J'utilise aussi QueryTable.Delete....
Quel est le rôle de .WebTables ?
Le .StatusBar visualise la vitesse de défilement des pages prélevées dans le
tableur (< 1 s / page textuelle)
.... mais il y en aura 100 000 à sortir (X=Array() n'est qu'une méthode de
test mais ce problème a une solution)....
J'écris actuellement un interprèteur textuel compatible avec la structure
des fiches malheureusement non absolument stable....
Certaines lignes de fiches n'existent pas systématiquement et d'autres
sorties varient entre "non valide" ou un tableau 2D entier.
Parfois certaines données sortent en doublon sur la même fiche produit.
Comment, sinon, par une autre méthode VBA-Web , identifier la nature d'une
sortie particulière dans une fiche produit ?

Cordialement

M41



"h2so4" a écrit dans le message de news:
gIPlh.266070$
' par exemple :

Sub retrievedatafromtheWeb()

X = Array("400-100-8", "400-010-9", "400-020-3", "400-030-8")



For Each i In X
'lancer un query pour chaque produit i dans la liste X

With Sheets(1).QueryTables.Add(Connection:= _

"URL;http://ecb.jrc.it/esis-pgm/esis_reponse.php?LANG=en&GENREìNO&ENTREE="
& i _
, Destination:=Sheets(1).Range("A1"))
.Name = "esis_reponse.php?LANG=en&GENREìNO&ENTREE=" & i
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True

' ajouter les réponses dans de nouvelles colonnes
.RefreshStyle = xlInsertDeleteCells

.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone

' les données se trouvent dans le tableau 10 sur la page WEB
.WebTables = "10"

.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:úlse
End With
Next

"h2so4" wrote in message
news:L9Nlh.265837$
as-tu essayé un web query ?

"M41" wrote in message
news:4595c27a$0$27407$
Bonjour

Ce programme ouvre une liste de pages internet correspondant à des codes
produits X.
Comment recopier les contenus (avec OnKey ?) ?
Comment fermer chaque page internet à partir d'Excel ?

Merci

M41



Option Base 0
Sub OuvrirToxicoCEE()
'
Dim X As Variant, i As Integer, T As String
X = Array("400-100-8", "400-010-9", "400-020-3", "400-030-8")
With Sheets("Feuil3").Range("A1")
T = "http://ecb.jrc.it/esis/"
.FormulaR1C1 = T
'.Hyperlinks(1).TextToDisplay = T
.Hyperlinks(1).Address = T
.Hyperlinks(1).ScreenTip = "Connexion CEE toxico !"
.Hyperlinks(1).Follow NewWindow:úlse, AddHistory:=True
With .Offset(1, 0)
For i = 0 To UBound(X, 1)
'2 possibilités OK
'T = "http://ecb.jrc.it/esis/index.php?GENREìNO&ENTREE=" &
X(i)
T =
"http://ecb.jrc.it/esis-pgm/esis_reponse.php?LANG=en&GENREìNO&ENTREE="
& X(i) & "#"
.FormulaR1C1 = T
.Hyperlinks(1).Address = T
.Hyperlinks(1).Follow NewWindow:úlse, AddHistory:=True
'*******************************
'copier le contenu ?
'coller des pages dans Excel : en manuel la meilleure solution
'... semble avec le collage spécial en forme texte sur A1 en
feuille 1
'fermer chaque page internet après copie ?
'*******************************
Next i
End With
.Offset(2, 0).Select
End With
End Sub












Avatar
h2so4
bonsoir M41,

Quel est le rôle de .WebTables ?


j'ai fait la supposition que tu n'avais pas besoin de toute l'info présente
sur la page web mais uniquement celle qui se trouvait dans une partie de
l'écran (table n°10), Pour trouver à quelle n° de webtable correspond quelle
info, il faudra faire du essai erreur ou bien utiliser l'enregistreur de
macro.

.... mais il y en aura 100 000 à sortir (X=Array() n'est qu'une méthode de
test mais ce problème a une solution)....


As-tu essayé de contacter le propriétaire de ces données pour voir si tu ne
pourrais obtenir cette info sous une autre forme ?

--
h2so4


"M41" wrote in message
news:4599abef$0$5079$
Bonsoir H2SO4, un pseudo prédestiné à la toxico corrosive

J'avais, depuis mon message, utilisé QueryTables à force de tout essayer
avec l'enregistreur de macro automatique.
On ne trouve pas beaucoup d'informations sur les paramètres de cette
fonction : y en a t il de facilement disponibles ?
Actuellement ma macro fonctionne très bien, bien que très légèrement
différente de celle proposée.
Je n'utilise pas .WebTables mais ajoute "_1" à la fin de la ligne .Name
!!! J'utilise aussi QueryTable.Delete....
Quel est le rôle de .WebTables ?
Le .StatusBar visualise la vitesse de défilement des pages prélevées dans
le tableur (< 1 s / page textuelle)
.... mais il y en aura 100 000 à sortir (X=Array() n'est qu'une méthode de
test mais ce problème a une solution)....
J'écris actuellement un interprèteur textuel compatible avec la structure
des fiches malheureusement non absolument stable....
Certaines lignes de fiches n'existent pas systématiquement et d'autres
sorties varient entre "non valide" ou un tableau 2D entier.
Parfois certaines données sortent en doublon sur la même fiche produit.
Comment, sinon, par une autre méthode VBA-Web , identifier la nature d'une
sortie particulière dans une fiche produit ?

Cordialement

M41


Avatar
h2so4
rebonsoir,

si le problème que tu as, est de pouvoir exploiter (recopier, ....) les
données rapatriées du web query, j'ai complété l'exemple.
il y a création automatique d'une fiche par produit recherché.

pour pouvoir utiliser cette macro, il faut qu'il y ait une feuille portant
le nom de "query".


Sub retrievedatafromtheWeb()

X = Array("400-100-8", "400-010-9", "400-020-3", "400-030-8")

'

For Each i In X
' lancer le query
With Sheets("query").QueryTables.Add(Connection:= _
"URL;http://ecb.jrc.it/esis-pgm/esis_reponse.php?LANG=en&GENREìNO&ENTREE="
& i _
, Destination:=Sheets("Query").Range("A1"))
.Name = "esis_reponse.php?LANG=en&GENREìNO&ENTREE=" & i
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:úlse
End With

'recopier les données trouvées dans une nouvelle feuille( ou une feuille
existante) portant le nom du produit

Sheets("query").Columns("A:C").Copy
found = False
For Each q In Sheets
If q.Name = i Then found = True: q.Select: Exit For
Next
If found = False Then Worksheets.Add: ActiveSheet.Name = i
ActiveSheet.Paste


Next
End Sub
"h2so4" wrote in message
news:U3Amh.269831$
bonsoir M41,

Quel est le rôle de .WebTables ?


j'ai fait la supposition que tu n'avais pas besoin de toute l'info
présente sur la page web mais uniquement celle qui se trouvait dans une
partie de l'écran (table n°10), Pour trouver à quelle n° de webtable
correspond quelle info, il faudra faire du essai erreur ou bien utiliser
l'enregistreur de macro.

.... mais il y en aura 100 000 à sortir (X=Array() n'est qu'une méthode
de test mais ce problème a une solution)....


As-tu essayé de contacter le propriétaire de ces données pour voir si tu
ne pourrais obtenir cette info sous une autre forme ?

--
h2so4


"M41" wrote in message
news:4599abef$0$5079$
Bonsoir H2SO4, un pseudo prédestiné à la toxico corrosive

J'avais, depuis mon message, utilisé QueryTables à force de tout essayer
avec l'enregistreur de macro automatique.
On ne trouve pas beaucoup d'informations sur les paramètres de cette
fonction : y en a t il de facilement disponibles ?
Actuellement ma macro fonctionne très bien, bien que très légèrement
différente de celle proposée.
Je n'utilise pas .WebTables mais ajoute "_1" à la fin de la ligne .Name
!!! J'utilise aussi QueryTable.Delete....
Quel est le rôle de .WebTables ?
Le .StatusBar visualise la vitesse de défilement des pages prélevées dans
le tableur (< 1 s / page textuelle)
.... mais il y en aura 100 000 à sortir (X=Array() n'est qu'une méthode
de test mais ce problème a une solution)....
J'écris actuellement un interprèteur textuel compatible avec la structure
des fiches malheureusement non absolument stable....
Certaines lignes de fiches n'existent pas systématiquement et d'autres
sorties varient entre "non valide" ou un tableau 2D entier.
Parfois certaines données sortent en doublon sur la même fiche produit.
Comment, sinon, par une autre méthode VBA-Web , identifier la nature
d'une sortie particulière dans une fiche produit ?

Cordialement

M41