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]

Rechercher des sujets similaires à "simplifier code"