Bonjour le Forum,
je viens solliciter votre aide pour modifier un Code qui me permettra d'importer en même temps d'une page Internet 2 données dont les adresses sont proches mais disjointes.
Pour importer ces données, j'utilise actuellement 2 codes différents et souhaiterais n'en utiliser qu'un seul ce qui, je pense, permettrait un gain de temps important (je dois lire plus de 200 pages et en importer 2 données par page).
Les codes utilisés sont les suivants :
Afin de vous permettre de mieux comprendre ma demande, je vous joins mon fichier "Essai 2".
Le Code à modifier est celui de la Macro "Lire_Objectifs_et_Potentiels" qui tel que je l'ai "bricolé", ne me permet d'importer que les Objectifs et pas les Potentiels.
Question supplémentaire : quel serait le Code si les 2 données se trouvaient à des adresses voisines (jointes) ?
Avec mes remerciements pour vos réponses et en vous souhaitant une bonne journée.
Cordialement.
Nonno 94.
je viens solliciter votre aide pour modifier un Code qui me permettra d'importer en même temps d'une page Internet 2 données dont les adresses sont proches mais disjointes.
Pour importer ces données, j'utilise actuellement 2 codes différents et souhaiterais n'en utiliser qu'un seul ce qui, je pense, permettrait un gain de temps important (je dois lire plus de 200 pages et en importer 2 données par page).
Les codes utilisés sont les suivants :
Code:
Sub Lire_Objectifs()
Sheets("Essai").Select 'Lire Objectifs
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim HtmlTag As IHTMLElementCollection
Dim Valeur As String, Cel As Range, I As Integer
ActiveSheet.Unprotect
For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
IE.Navigate Cel
IE.Visible = False
Do Until IE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set IEDoc = IE.document
Set HtmlTag = IEDoc.getElementsByTagName("td")
Valeur = "N/A"
For I = 0 To HtmlTag.Length - 1
If HtmlTag.Item(I).innerText = "Objectif de cours à 3 mois" Then
Valeur = HtmlTag.Item(I + 1).innerText
Exit For
End If
Next I
Cel.Offset(, 1) = Valeur
Next Cel
Set HtmlTag = Nothing
Set IEDoc = Nothing
Set IE = Nothing
Range("B1").Select
ActiveSheet.Protect
ActiveWorkbook.Save
End Sub
Code:
Sub Lire_Potentiels()
Sheets("Essai").Select 'Lire Potentiels
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim HtmlTag As IHTMLElementCollection
Dim Valeur As String, Cel As Range, I As Integer
ActiveSheet.Unprotect
For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
IE.Navigate Cel
IE.Visible = False
Do Until IE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set IEDoc = IE.document
Set HtmlTag = IEDoc.getElementsByTagName("td")
Valeur = "N/A"
For I = 0 To HtmlTag.Length - 1
If HtmlTag.Item(I).innerText = "Objectif de cours à 3 mois" Then
Valeur = HtmlTag.Item(I + 3).innerText
Exit For
End If
Next I
Cel.Offset(, 2) = Valeur
Next Cel
Set HtmlTag = Nothing
Set IEDoc = Nothing
Set IE = Nothing
Range("C1").Select
ActiveSheet.Protect
ActiveWorkbook.Save
End Sub
Afin de vous permettre de mieux comprendre ma demande, je vous joins mon fichier "Essai 2".
Le Code à modifier est celui de la Macro "Lire_Objectifs_et_Potentiels" qui tel que je l'ai "bricolé", ne me permet d'importer que les Objectifs et pas les Potentiels.
Question supplémentaire : quel serait le Code si les 2 données se trouvaient à des adresses voisines (jointes) ?
Avec mes remerciements pour vos réponses et en vous souhaitant une bonne journée.
Cordialement.
Nonno 94.