Simplifier Code
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
[code][/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]