spiritoftravel
XLDnaute Nouveau
Bonjour à tous,
j'ai récupéré une appli excel qui vient compiler deux sites intranet de ma société. Apparement les sites ont changés car l'appli ne fonctionne plus. je ne suis débutant en VBA, mais là je séche devant le problème suivant.
voici le menu que je souhaite atteindre:
voici le code html du menu " flux de voyageurs"
voici le code VBA qui ne fonctionne pas pour selectionner le menu flux de voyageurs sous le menu Occupation
Merci de votre aide
j'ai récupéré une appli excel qui vient compiler deux sites intranet de ma société. Apparement les sites ont changés car l'appli ne fonctionne plus. je ne suis débutant en VBA, mais là je séche devant le problème suivant.
voici le menu que je souhaite atteindre:
voici le code html du menu " flux de voyageurs"
HTML:
<div id="ratMenu4_8" style="background-color: #ffcc33;" onmouseover="onLayerColor('ratMenu4','','ratMenu4_8')" onmouseout="offLayerColor('ratMenu4','','ratMenu4_8')">
Code:
Option Explicit
'Délclaration avec l'api windows pour l'utilisation de la fonction sleep
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private T(0, 50)
Private Result, N, J, K, ListMatos, NbErr, NbErr2 As Integer
Private PresTrain As Object
Private TabMarche() As String
'Declaration MODE INTERNET EXPLORER
'Dim IEDoc, IEDoc2 As HTMLDocument
Dim IEDoc, IEDoc2 As Object
Dim InputZoneText As HTMLInputElement
Dim InputZoneText1 As Object
Dim InputButton As HTMLInputElement
Public htmlTabElement() As IHTMLElement
Dim InputList As HTMLListElement
Dim HtmlTB As HTMLTable
Dim htmlSelectElem As HTMLListElement
'Dim htmlSelectElem As HTMLSelectElement
'Declaration pour la fonction getElementsByClassName
Dim aElement As IHTMLElement
Dim FuncElements() As IHTMLElement
Dim SourceElem As IHTMLElementCollection
Dim Found, FoundO, FoundD As Boolean
Dim iElem, F, O, Y As Integer
'Declaration pour les variables Base Assistance
Dim PosSillon, ValMax As Integer
Dim GareOBA, GareDBA As String
Dim Check As HTMLObjectElement
Public Function BotIE_BA(ByRef IE As InternetExplorer, ByVal DateBA As String, ByVal PR As String, ByVal Log As String, ByVal Pass As String) As String
''''''''''''''''''''''''''''''''''''''
'Fonction de recherche Base Assistance
''''''''''''''''''''''''''''''''''''''
NbErr = 0
NbErr2 = 0
'Récupération de la liste des trains de la feuille "Général" dans un tableau "virtuel"
'que l'on appelle "TabMarche", qui va nous servir de tampon pendant la recherche
With ThisWorkbook.Worksheets("Général")
ListMatos = .Range("A6").End(xlDown).Row - 6
ReDim TabMarche(ListMatos, 2)
For J = 0 To ListMatos
TabMarche(J, 0) = .Range("A" & J + 6).Value
Next J
End With
IE.navigate "https://www.int.sncf.fr/"
WaitIE IE
'Lancement de la navigation dans Base Assistance
IE.navigate "http://base-assistance.sncf.fr/"
IE.Visible = False
'on attend que IE charge la page en entier
WaitIE IE
Set IEDoc = IE.document
'Bloc de login Base Assistance, permetant de verifier si on est déja connecté
IEDoc.parentWindow.Location.href = "/commun/html/prive/commun/cadrePrincipal.html?time="
Application.Wait DateAdd("s", 2, Now)
If Not IE.LocationURL = "http://base-assistance.sncf.fr/commun/html/prive/commun/cadrePrincipal.html?time=." Then
If Not IE.LocationURL = "http://base-assistance.sncf.fr/commun/html/prive/commun/cadrePrincipal.html?time=" Then
'Si ce n'est pas le cas on se connecte avec les éléments renseignés dans la feuille "Général"
Set InputZoneText = IEDoc.all("j_username")
InputZoneText.Value = Log
Set InputZoneText = IEDoc.all("j_password")
InputZoneText.Value = Pass
Set InputButton = IEDoc.all("btn_valider")
InputButton.Click
End If
End If
WaitIE IE
Sleep 2000
'Boucle d'attente
Do Until Not IEDoc.all.Item(18) Is Nothing
DoEvents
Loop
Set IEDoc2 = IEDoc.all.Item(18)
Do Until Not IEDoc2.all("ratMenu4_8") Is Nothing
DoEvents
Loop
'Click sur le bouton "Flux voyageurs" du menu "Occupation"
Set InputZoneText = IEDoc2.all("ratMenu4_8") 'NE FONCTIONNE PAS
InputZoneText.Children.Item(0).Click 'NE FONCTIONNE PAS
WaitIE IE
'Pause en ms
Sleep 500