Simplifier Code

Y compris Power BI, Power Query et toute autre question en lien avec Excel
D
Dehbi
Membre habitué
Membre habitué
Messages : 90
Inscrit le : 30 décembre 2017
Version d'Excel : 2010

Message par Dehbi » 2 janvier 2019, 00:01

bonsoir,

avant tout je tiens a vous souhaitez a tous une excellente année 2019

Je sollicite votre aide afin de me corriger le code suivant car etant debutant j'ai fais une macro qui me permet de remplir un formulaire Internet via Excel mais je trouve un peu chargé .qui d'ailleurs fonctionne tres bien mais je prefere m'adresser aux personnes qui maitrise VBA

Je vous remercie de votre support

[/Sub RemplirForms()

 

Dim IEDoc As Object
Dim sws As SHDocVw.ShellWindows
Dim strURL As String
Dim n As Integer


   Dim IE As InternetExplorer
 
   Dim htmlSelectElem As HTMLSelectElement
  
Dim sDate$, default, Title, message, pcs As Integer

 
 
 If MsgBox("Voulez-vous continuer? (Y/N)", vbYesNo) = vbYes Then
   
  



marker = 0
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For x = 0 To (IE_count - 1)
    On Error Resume Next    ' sometimes more web pages are counted than are open
    my_url = objShell.Windows(x).Document.Location
    my_title = objShell.Windows(x).Document.Title

    If my_title Like "Reroute By Cons Request" & "*" Then 'compare to find if the desired web page is already open
        Set IE = objShell.Windows(x)
        marker = 1
        Exit For
    Else
    End If
Next



 
Set IEDoc = objShell.Windows(x).Document


            
With ActiveSheet
            n = .range("C" & .Rows.Count).End(xlUp).Row
            For i = 2 To n
                j = 0
                Do
 
   objShell.Windows(x).Document.getElementsByName("routeOrigLoc").Item.innerText = "cdg"
   
  objShell.Windows(x).Document.getElementsByName("newRoute").Item.innerText = Cells(i + j, 3).Value
  
  objShell.Windows(x).Document.getElementsByName("routeDt").Item.innerText = Cells(i + j, 5).Value
  
  
        
                    
 objShell.Windows(x).Document.getElementsByName("consNbr0").Item.innerText = Cells(i + j, 10).Value
    j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
  
  
  objShell.Windows(x).Document.getElementsByName("consNbr1").Item.innerText = Cells(i + j, 10).Value
    j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
  
  
  objShell.Windows(x).Document.getElementsByName("consNbr2").Item.innerText = Cells(i + j, 10).Value
   j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
  
  
  objShell.Windows(x).Document.getElementsByName("consNbr3").Item.innerText = Cells(i + j, 10).Value
    j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
  
  
  objShell.Windows(x).Document.getElementsByName("consNbr4").Item.innerText = Cells(i + j, 10).Value
    j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
  
  
  objShell.Windows(x).Document.getElementsByName("consNbr5").Item.innerText = Cells(i + j, 10).Value
    j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
  
  
  objShell.Windows(x).Document.getElementsByName("consNbr6").Item.innerText = Cells(i + j, 10).Value
    j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
  
  
  objShell.Windows(x).Document.getElementsByName("consNbr7").Item.innerText = Cells(i + j, 10).Value
    j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
  
  
  
  objShell.Windows(x).Document.getElementsByName("consNbr8").Item.innerText = Cells(i + j, 10).Value
    j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
  
  
  
  objShell.Windows(x).Document.getElementsByName("consNbr9").Item.innerText = Cells(i + j, 10).Value
    j = j + 1
   
   If Cells(i + j, 3) <> Cells(i + j - 1, 3) Then
  GoTo Jump
  End If
     
       
Jump:

 
   objShell.Windows(x).Document.getElementsByName("Reroute CONS")(0).Click
    
   
   objShell.Windows(x).Document.getElementsByName("Reroute CONS")(0).Click
  Do While IE.Busy = True Or IE.ReadyState <> 4: DoEvents: Loop
 
 
   
   
   objShell.Windows(x).Document.getElementsByName("RerouteYes")(0).Click
  Do While IE.Busy = True Or IE.ReadyState <> 4: DoEvents: Loop
  
 
  objShell.Windows(x).Document.getElementsByName("updateStatus")(0).Click
   Do While IE.Busy = True Or IE.ReadyState <> 4: DoEvents: Loop
  
 
  objShell.Windows(x).Document.getElementsByName("updateStatus")(0).Click
 Do While IE.Busy = True Or IE.ReadyState <> 4: DoEvents: Loop
  
 
  objShell.Windows(x).Document.getElementsByName("updateStatus")(0).Click
   Do While IE.Busy = True Or IE.ReadyState <> 4: DoEvents: Loop
  
  
  
  
For Each oHTML_Element In objShell.Windows(x).Document.getElementsByTagName("a")
        If oHTML_Element.innerText = "Reroute By Cons" Then
            oHTML_Element.Click
                  
        End If
        Next
    
    
    
    
    Do While IE.Busy = True Or IE.ReadyState <> 4: DoEvents: Loop
 
                
        objShell.Windows(x).Document.getElementsByName("Clear")(0).Click
         Do While IE.Busy = True Or IE.ReadyState <> 4: DoEvents: Loop
                
 

 
 Loop While .Cells(i + j, 3) = .Cells(i + j - 1, 3)
 i = i + j - 1
 

Next i

End With

 Else
 Exit Sub
 End If


Set IE = Nothing
Set objShell.Windows(x).Document = Nothing

MsgBox "Terminé"

End Subcode]
  • Sujets similaires
    Réponses
    Vues
    Dernier message