- 'Il est nécessaire de référencer IE dans votre programme dans le VBA
- 'outils - références - référencer les outils ... sinon ca marche pas ....
-
-
- 'Code à insérer dans un module
-
- Public Etat As String
- Public IE As New InternetExplorer '****** Internet Explorer
- Public LibelleLien As String '****** Libelle du lien IE
-
-
-
- Sub ConnectionIE()
-
- 'définition de IE en tant que nouvel Objet
- 'rend IE visible
- IE.Visible = True
- 'IE navique vers le site demandé
- IE.Navigate2 "http://www.VotreSite.fr/"
-
- 'Fonction Timer ... regardé plus bas ... la fonction est décrite
- If Timer = False Then GoTo Error_Timer
-
- 'défini la variable de la page web.
- Dim htmlDoc As HTMLDocument
- Set htmlDoc = IE.document
- While htmlDoc.Title <> "Nom de la page Web"
- Wend
-
- 'la variable htmlDoc peut prendre les attributs suivants :
- IETxt = htmlDoc.documentElement.innerText 'récupère le texte de la page HTML
- IESource = htmlDoc.documentElement.innerHTML 'récupère le code source de la page HTML
- IETitre = htmlDoc.Title 'récupère le Titre du document HTML
- IENom = htmlDoc.Name 'récupère le Nom "Microsoft Internet Explorer"
-
-
- '**************** Défini le un controle de la page **************************
- Dim IECtrl As HTMLFormElement
- Set IECtrl = htmlDoc.forms(0).'Nom du controle
- 'Insert une valeur dans un controle dans la page en cours
- IECtrl.Value = "La Valeur Que je veux y mettre"
-
- 'récupère une valeur d'un controle de la page en cours et le met dans une cellule
- Selection = IECtrl.Value
-
- '**************** Défini l'envoi de la page ne cours (simulation de la touche entrer *************************
- Dim IESubmit As HTMLFormElement
- Set IESubmit = htmlDoc.forms(0)
- IESubmit.submit
- If Timer = False Then GoTo Error_Timer
-
- '**************** Ckiquer sur un lien IE************************
- If CliquerLien("libellé du lien sur IE", "Nom de la page suivante") = False Then Exit Sub
-
-
- '**************** Arret Programme correctement ************************
- IE_Fin:
- Application.Visible = True
- MsgBox "Arrêt du programme", vbInformation, "Fin"
-
- '**************** Arret Programme Error Timer ************************
- Error_Timer:
- IE.Quit
- Set IE = Nothing
- End Sub
-
-
- '**********************************************************************************
- '**************************** FONCTION TIMER DE IE ************************
- '**********************************************************************************
- Function Timer() As Boolean
- On Error GoTo Error_IE_Timer
- While IE.readyState <> READYSTATE_COMPLETE
- Wend
- While IE.Busy
- Wend
- Timer = True
- Exit Function
- Error_IE_Timer:
- Timer = False
- MsgBox "Arrêt de Internet Explorer dû à une erreur interne de l'application", vbInformation, "Erreur Application Internet Explorer"
- End Function
-
- '**********************************************************************************
- '**************************** FONCTION Cliquer sur lien IE ************************
- '**********************************************************************************
- Public Function CliquerLien(LibelleLien As String, Optional NomPageSuivante As String) As Boolean
- On Error GoTo ErrLien 'si erreur av ç la gestion de l'erreur
- Dim ObjLien As HTMLLinkElement (défini les liens de la page en Objet
- For Each ObjLien In IE.document.Links 'pour chaque lien de la page active
- If ObjLien.innerText = LibelleLien Then 'si le text du lien = au Libellé visible sur la page alors
- TextePage = IE.document.documentElement.innerText
- ObjLien.Click 'clique sur le lien
- If Timer = False Then GoTo ErrTimer 'gestion du time sur IE
- If NomPageSuivante <> "" Then 'si le nom de la page a été renseigné dnas la fonction alors
- While IE.document.Title <> NomPageSuivante 'attends jusqua ce que la page change (2e gestion du passage de la page qui peuit etre tres utile)
- Wend
- Else
- While IE.document.documentElement.innerText <> TextePage
- Wend
- End If
- CliquerLien = True: Exit Function 'tout c'est bien passer alors la fonction CliquerLien prend la TRUE
- Exit For
- End If
- Next ObjLien
-
-
- 'Sinon prend la valur FALSE
- CliquerLien = False
- 'Permet de demander à l'utilisateur s'il désire terminé l'action manuellement dans le cas ou cela n'a pas fonctionné
- Message = "Une erreur est surevenue sur le lien : " & LibelleLien & "."
- Message = Message & vbCrLf & "Oui : Je souhaite terminer l'action manuellement ?"
- Message = Message & vbCrLf & "Non : Je souhaite terminer le programme ?"
- If MsgBox(Message, vbQuestion + vbYesNo, "Erreur sur le lien : < " & LibelleLien & " >") = vbYes Then
- TextePage = IE.document.documentElement.innerText
- While TextePage = IE.document.documentElement.innerText
- Wend
- If Timer = False Then GoTo ErrTimer
- CliquerLien = True: Exit Function
- End If
-
- ErrLien:
- CliquerLien = False: Exit Function
-
- ErrTimer:
-
- IE.Quit
- Set IE = Nothing: Exit Function
-
- End Function
-
-
- '**********************************************************************************
- '********************** Fonction RECUPERER TEXTE sur IE par Valeur Texte **********
- '**********************************************************************************
- Public Function RécupérerTexte(TexteARechercher As String, TexteARécupérer As String) As String
- Dim MaPosition As Variant
- Dim TextePage As String
-
- On Error GoTo ErrRécupérerTexte
-
- TextePage = IE.document.documentElement.innerText 'récuper le texte entier de la page IE (faite un test avec msgbox TextePage)
- MaPosition = InStr(1, TextePage, TexteARechercher)
- RécupérerTexte = Mid(TextePage, MaPosition + Len(TexteARechercher), Len(TexteARécupérer))
- Exit Function
-
-
-
- ErrRécupérerTexte:
- SearchTexte = False
- End Function
'Il est nécessaire de référencer IE dans votre programme dans le VBA
'outils - références - référencer les outils ... sinon ca marche pas ....
'Code à insérer dans un module
Public Etat As String
Public IE As New InternetExplorer '****** Internet Explorer
Public LibelleLien As String '****** Libelle du lien IE
Sub ConnectionIE()
'définition de IE en tant que nouvel Objet
'rend IE visible
IE.Visible = True
'IE navique vers le site demandé
IE.Navigate2 "http://www.VotreSite.fr/"
'Fonction Timer ... regardé plus bas ... la fonction est décrite
If Timer = False Then GoTo Error_Timer
'défini la variable de la page web.
Dim htmlDoc As HTMLDocument
Set htmlDoc = IE.document
While htmlDoc.Title <> "Nom de la page Web"
Wend
'la variable htmlDoc peut prendre les attributs suivants :
IETxt = htmlDoc.documentElement.innerText 'récupère le texte de la page HTML
IESource = htmlDoc.documentElement.innerHTML 'récupère le code source de la page HTML
IETitre = htmlDoc.Title 'récupère le Titre du document HTML
IENom = htmlDoc.Name 'récupère le Nom "Microsoft Internet Explorer"
'**************** Défini le un controle de la page **************************
Dim IECtrl As HTMLFormElement
Set IECtrl = htmlDoc.forms(0).'Nom du controle
'Insert une valeur dans un controle dans la page en cours
IECtrl.Value = "La Valeur Que je veux y mettre"
'récupère une valeur d'un controle de la page en cours et le met dans une cellule
Selection = IECtrl.Value
'**************** Défini l'envoi de la page ne cours (simulation de la touche entrer *************************
Dim IESubmit As HTMLFormElement
Set IESubmit = htmlDoc.forms(0)
IESubmit.submit
If Timer = False Then GoTo Error_Timer
'**************** Ckiquer sur un lien IE************************
If CliquerLien("libellé du lien sur IE", "Nom de la page suivante") = False Then Exit Sub
'**************** Arret Programme correctement ************************
IE_Fin:
Application.Visible = True
MsgBox "Arrêt du programme", vbInformation, "Fin"
'**************** Arret Programme Error Timer ************************
Error_Timer:
IE.Quit
Set IE = Nothing
End Sub
'**********************************************************************************
'**************************** FONCTION TIMER DE IE ************************
'**********************************************************************************
Function Timer() As Boolean
On Error GoTo Error_IE_Timer
While IE.readyState <> READYSTATE_COMPLETE
Wend
While IE.Busy
Wend
Timer = True
Exit Function
Error_IE_Timer:
Timer = False
MsgBox "Arrêt de Internet Explorer dû à une erreur interne de l'application", vbInformation, "Erreur Application Internet Explorer"
End Function
'**********************************************************************************
'**************************** FONCTION Cliquer sur lien IE ************************
'**********************************************************************************
Public Function CliquerLien(LibelleLien As String, Optional NomPageSuivante As String) As Boolean
On Error GoTo ErrLien 'si erreur av ç la gestion de l'erreur
Dim ObjLien As HTMLLinkElement (défini les liens de la page en Objet
For Each ObjLien In IE.document.Links 'pour chaque lien de la page active
If ObjLien.innerText = LibelleLien Then 'si le text du lien = au Libellé visible sur la page alors
TextePage = IE.document.documentElement.innerText
ObjLien.Click 'clique sur le lien
If Timer = False Then GoTo ErrTimer 'gestion du time sur IE
If NomPageSuivante <> "" Then 'si le nom de la page a été renseigné dnas la fonction alors
While IE.document.Title <> NomPageSuivante 'attends jusqua ce que la page change (2e gestion du passage de la page qui peuit etre tres utile)
Wend
Else
While IE.document.documentElement.innerText <> TextePage
Wend
End If
CliquerLien = True: Exit Function 'tout c'est bien passer alors la fonction CliquerLien prend la TRUE
Exit For
End If
Next ObjLien
'Sinon prend la valur FALSE
CliquerLien = False
'Permet de demander à l'utilisateur s'il désire terminé l'action manuellement dans le cas ou cela n'a pas fonctionné
Message = "Une erreur est surevenue sur le lien : " & LibelleLien & "."
Message = Message & vbCrLf & "Oui : Je souhaite terminer l'action manuellement ?"
Message = Message & vbCrLf & "Non : Je souhaite terminer le programme ?"
If MsgBox(Message, vbQuestion + vbYesNo, "Erreur sur le lien : < " & LibelleLien & " >") = vbYes Then
TextePage = IE.document.documentElement.innerText
While TextePage = IE.document.documentElement.innerText
Wend
If Timer = False Then GoTo ErrTimer
CliquerLien = True: Exit Function
End If
ErrLien:
CliquerLien = False: Exit Function
ErrTimer:
IE.Quit
Set IE = Nothing: Exit Function
End Function
'**********************************************************************************
'********************** Fonction RECUPERER TEXTE sur IE par Valeur Texte **********
'**********************************************************************************
Public Function RécupérerTexte(TexteARechercher As String, TexteARécupérer As String) As String
Dim MaPosition As Variant
Dim TextePage As String
On Error GoTo ErrRécupérerTexte
TextePage = IE.document.documentElement.innerText 'récuper le texte entier de la page IE (faite un test avec msgbox TextePage)
MaPosition = InStr(1, TextePage, TexteARechercher)
RécupérerTexte = Mid(TextePage, MaPosition + Len(TexteARechercher), Len(TexteARécupérer))
Exit Function
ErrRécupérerTexte:
SearchTexte = False
End Function