1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
| Sub Finale3()
Application.EnableEvents = True
Dim compteur As Integer
compteur = 0
Sheets("Feuil1").Select
While compteur < Range("K2")
'définition de l'hyperlien
navigate = Cells(compteur + 3, 12)
'ouverture de la page de l'hyperlien
Shell ("C:\Program Files\Mozilla Firefox\firefox.exe -url " & navigate)
' chargement de la page
Application.Wait Now + TimeValue("0:00:06")
' positionnement de la sélection dans la fenêtre d'adresse
CreateObject("WScript.Shell").SendKeys ("{F6}"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
'première boucle pour déplacer la sélection sur le bouton voulu
Dim numero As Integer
numero = 1
While numero < 12
CreateObject("WScript.Shell").SendKeys ("{TAB}"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
numero = numero + 1
Wend
'clic sur le bouton
CreateObject("WScript.Shell").SendKeys ("{ENTER}"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
'seconde boucle pour déplacer la sélection sur le second bouton voulu
Dim comptage As Integer
comptage = 1
While comptage < 13
CreateObject("WScript.Shell").SendKeys ("{TAB}"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
comptage = comptage + 1
Wend
'clic sur le second bouton
CreateObject("WScript.Shell").SendKeys ("{ENTER}"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
'déplacement de la sélection jusqu'au bouton précédent le texte recherché
CreateObject("WScript.Shell").SendKeys ("{TAB}"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
'sélection du texte recherché
CreateObject("WScript.Shell").SendKeys ("^+{RIGHT}"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
CreateObject("WScript.Shell").SendKeys ("^+{RIGHT}"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
CreateObject("WScript.Shell").SendKeys ("^+{RIGHT}"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
'copie du texte cherché
CreateObject("WScript.Shell").SendKeys ("^c"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
' fermeture de l'onglet actif du navigateur
CreateObject("WScript.Shell").SendKeys ("^w"), True
For Boucle = 0 To 10000
DoEvents
Next Boucle
' collage du texte voulu dans la feuille Excel
Sheets("Feuil1").Select
Cells(compteur + 3, 9).Select
ActiveSheet.Paste
For Boucle = 0 To 10000
DoEvents
Next Boucle
compteur = compteur + 1
Wend
End Sub |
Partager