Pb avec sendkeys et CTRL+A, CTRL+C, CTRL+V

Le
Michel Angelosanto
Bonjour,

A partir d'Excel, j'essaie de récupérer des données avec IE que je pilote
avec des commandes passées par sendkeys.

Le pb c'est que les commandes sélectionner tout CTRL+A, copier CTRL+C et
coller CTRL+V ne marchent pas ans IE via sendkeys alors que manuellement
tout va bien.

Auriez-vous une idée ? Je vous joins le code dans lequel j'ai mis des pauses
pour voir ce qui se passe (ou plutot ne se passe pas!)

Merci pour votre aide.

Sub interro_coordonnees_gps()
Set ws = VBA.CreateObject("WScript.Shell")
ws.SendKeys "%{TAB}" 'ok on va sur IE
Application.Wait (Now + TimeValue("0:00:01"))
SetURL "http://www.gpsfrance.net/services/adresse2gps.php"
clic 1195, 99 'click sur ok
ws.SendKeys "%{TAB}" 'ok on revient sur Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(1, 2).Copy
ws.SendKeys "%{TAB}" 'ok on passe sur IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 372, 183
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^V" 'pas ok
clic 707, 179 'bouton Convertir en coordonnées GPS
Application.Wait (Now + TimeValue("0:00:05"))
clic 256, 210 'click dans la zone latitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 2).Select
ws.SendKeys "^V" 'ok on est dans Excel
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 416, 210 'click dans la zone longitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 4).Select
ws.SendKeys "^V" 'ok on est dans Excel
End Sub

Michel Angelosanto, Bordeaux, France
Questions / Réponses high-tech
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #19924361
Bonjour Michel,

Voici une façon de faire pour récupérer le texte
du contrôle dans la page web :

'-------------------------------------
Sub Récupérer_Page_Web()
Dim Wk As Workbook, Sh As Shape
Dim Adr As String
Adr = "http://www.gpsfrance.net/services/adresse2gps.php"
Application.ScreenUpdating = False
Set Wk = Workbooks.Open("http://www.gpsfrance.net/services/adresse2gps.php")
Texte = Wk.Worksheets(1).Shapes _
("Contrôle 1").OLEFormat.Object.Object
Wk.Close False
Application.ScreenUpdating = True
MsgBox Texte
End Sub
'-------------------------------------



"Michel Angelosanto"
Bonjour,

A partir d'Excel, j'essaie de récupérer des données avec IE que je pilote
avec des commandes passées par sendkeys.

Le pb c'est que les commandes sélectionner tout CTRL+A, copier CTRL+C et
coller CTRL+V ne marchent pas ans IE via sendkeys alors que manuellement
tout va bien.

Auriez-vous une idée ? Je vous joins le code dans lequel j'ai mis des pauses
pour voir ce qui se passe (ou plutot ne se passe pas!)

Merci pour votre aide.

Sub interro_coordonnees_gps()
Set ws = VBA.CreateObject("WScript.Shell")
ws.SendKeys "%{TAB}" 'ok on va sur IE
Application.Wait (Now + TimeValue("0:00:01"))
SetURL "http://www.gpsfrance.net/services/adresse2gps.php"
clic 1195, 99 'click sur ok
ws.SendKeys "%{TAB}" 'ok on revient sur Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(1, 2).Copy
ws.SendKeys "%{TAB}" 'ok on passe sur IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 372, 183
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^V" 'pas ok
clic 707, 179 'bouton Convertir en coordonnées GPS
Application.Wait (Now + TimeValue("0:00:05"))
clic 256, 210 'click dans la zone latitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 2).Select
ws.SendKeys "^V" 'ok on est dans Excel
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 416, 210 'click dans la zone longitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 4).Select
ws.SendKeys "^V" 'ok on est dans Excel
End Sub

Michel Angelosanto, Bordeaux, France
Michel Angelosanto
Le #19924571
C'est intéressant mais si j'ai bien compris, ce n'est pas dynamique, tu
ouvres la page comme si c'était un fichier et lis les infos dedans, mais
peux-tu changer l'adresse puis cliquer sur le bouton pour obtenir les
coordonnées longitude et latitude?
Une fois le bouton cliqué, ta méthode serait très intéressante pour lire les
infos retournées.

Le 2e problème est que je ne veux pas créer une occurrence de IE via le vba
car au bureau, le lancement de IE est très long à cause des sécurités de
plus je n'arrives pas à récupérer l'objet IE existant toujours à cause des
droits getobjet(,internetexplorer.application)
C'est pourquoi je passes par des alt+tab pour basculer entre IE et Excel.
En fait je dois rechercher de nombreuses adresses et il faut que ce soit le
plus rapide possible.

Merci pour cette astuce qui me servira surement.

"MichDenis" news:
Bonjour Michel,

Voici une façon de faire pour récupérer le texte
du contrôle dans la page web :

'-------------------------------------
Sub Récupérer_Page_Web()
Dim Wk As Workbook, Sh As Shape
Dim Adr As String
Adr = "http://www.gpsfrance.net/services/adresse2gps.php"
Application.ScreenUpdating = False
Set Wk =
Workbooks.Open("http://www.gpsfrance.net/services/adresse2gps.php")
Texte = Wk.Worksheets(1).Shapes _
("Contrôle 1").OLEFormat.Object.Object
Wk.Close False
Application.ScreenUpdating = True
MsgBox Texte
End Sub
'-------------------------------------



"Michel Angelosanto" de discussion :

Bonjour,

A partir d'Excel, j'essaie de récupérer des données avec IE que je pilote
avec des commandes passées par sendkeys.

Le pb c'est que les commandes sélectionner tout CTRL+A, copier CTRL+C et
coller CTRL+V ne marchent pas ans IE via sendkeys alors que manuellement
tout va bien.

Auriez-vous une idée ? Je vous joins le code dans lequel j'ai mis des
pauses
pour voir ce qui se passe (ou plutot ne se passe pas!)

Merci pour votre aide.

Sub interro_coordonnees_gps()
Set ws = VBA.CreateObject("WScript.Shell")
ws.SendKeys "%{TAB}" 'ok on va sur IE
Application.Wait (Now + TimeValue("0:00:01"))
SetURL "http://www.gpsfrance.net/services/adresse2gps.php"
clic 1195, 99 'click sur ok
ws.SendKeys "%{TAB}" 'ok on revient sur Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(1, 2).Copy
ws.SendKeys "%{TAB}" 'ok on passe sur IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 372, 183
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^V" 'pas ok
clic 707, 179 'bouton Convertir en coordonnées GPS
Application.Wait (Now + TimeValue("0:00:05"))
clic 256, 210 'click dans la zone latitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 2).Select
ws.SendKeys "^V" 'ok on est dans Excel
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 416, 210 'click dans la zone longitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 4).Select
ws.SendKeys "^V" 'ok on est dans Excel
End Sub

Michel Angelosanto, Bordeaux, France



Michel Angelosanto, Bordeaux, France
MichDenis
Le #19925021
Bonjour Michel,

Voici, j'ai fait une tentative et le résultat est au rendez-vous !

Tu dois ajouter au module, la référence suivante à ton projet VBA
barre des menus / outils / références / et tu coches :
"Microsoft Forms 2.0 Object Library"

Cette ligne de code pourrait être différente sur ta machine
Application.SendKeys "{TAB 9}"
Le 9 représente le nombre de tab... selon ton environnement
cela pourrait varier....! à tester

Il ne te reste plus qu'à insérer ceci dans une boucle pour
l'alimenter en adresses.

Le temps des Application.Wait() peuvent être resserrés selon
ta machine !

Amuse-toi bien !

'Déclaration des API dans le haut du module standard
'--------------------------------------------
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
'--------------------------------------------
Sub Vider_Presse_Papier()
OpenClipboard 0
EmptyClipboard
CloseClipboard
End Sub
'--------------------------------------------
Sub Denis()
Dim X As New DataObject
Dim IE As Object
Dim Adr As String
Dim Adresse As String
Vider_Presse_Papier
Adresse = "1000 st-laurent montréal qc canada"
Adr = "http://www.gpsfrance.net/services/adresse2gps.php"
Set IE = CreateObject("internetexplorer.application")
IE.Visible = True
IE.Navigate (Adr)
Application.Wait Now + TimeValue("00:00:04")
Application.SendKeys "{TAB 9}"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys Adresse
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "{TAB}" & "~"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "{TAB}"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
X.GetFromClipboard
MyVar = X.GetText(1)
Range("A1") = MyVar
Vider_Presse_Papier
Application.Wait Now + TimeValue("00:00:03")
Application.SendKeys "{TAB}"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
X.GetFromClipboard
MyVar = X.GetText(1)
Range("B1") = MyVar
'stop
Vider_Presse_Papier
Application.Wait Now + TimeValue("00:00:03")
Application.SendKeys "{TAB 13}"
Application.Wait Now + TimeValue("00:00:03")
Adresse = "2805 Laval qc canada"
Application.SendKeys Adresse
Application.Wait Now + TimeValue("00:00:03")
Application.SendKeys "{TAB}" & "~"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "{TAB}"
End Sub
'--------------------------------------------



"Michel Angelosanto"
Bonjour,

A partir d'Excel, j'essaie de récupérer des données avec IE que je pilote
avec des commandes passées par sendkeys.

Le pb c'est que les commandes sélectionner tout CTRL+A, copier CTRL+C et
coller CTRL+V ne marchent pas ans IE via sendkeys alors que manuellement
tout va bien.

Auriez-vous une idée ? Je vous joins le code dans lequel j'ai mis des pauses
pour voir ce qui se passe (ou plutot ne se passe pas!)

Merci pour votre aide.

Sub interro_coordonnees_gps()
Set ws = VBA.CreateObject("WScript.Shell")
ws.SendKeys "%{TAB}" 'ok on va sur IE
Application.Wait (Now + TimeValue("0:00:01"))
SetURL "http://www.gpsfrance.net/services/adresse2gps.php"
clic 1195, 99 'click sur ok
ws.SendKeys "%{TAB}" 'ok on revient sur Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(1, 2).Copy
ws.SendKeys "%{TAB}" 'ok on passe sur IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 372, 183
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^V" 'pas ok
clic 707, 179 'bouton Convertir en coordonnées GPS
Application.Wait (Now + TimeValue("0:00:05"))
clic 256, 210 'click dans la zone latitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 2).Select
ws.SendKeys "^V" 'ok on est dans Excel
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 416, 210 'click dans la zone longitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 4).Select
ws.SendKeys "^V" 'ok on est dans Excel
End Sub

Michel Angelosanto, Bordeaux, France
MichDenis
Le #19925011
Bonjour Michel,

Voici, j'ai fait une tentative et le résultat est au rendez-vous !

Tu dois ajouter au module, la référence suivante à ton projet VBA
barre des menus / outils / références / et tu coches :
"Microsoft Forms 2.0 Object Library"

Cette ligne de code pourrait être différente sur ta machine
Application.SendKeys "{TAB 9}"
Le 9 représente le nombre de tab... selon ton environnement
cela pourrait varier....! à tester

Il ne te reste plus qu'à insérer ceci dans une boucle pour
l'alimenter en adresses.

Le temps des Application.Wait() peuvent être resserrés selon
ta machine !

Amuse-toi bien !

'Déclaration des API dans le haut du module standard
'------------------------------------------
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
'------------------------------------------
Sub Vider_Presse_Papier()
OpenClipboard 0
EmptyClipboard
CloseClipboard
End Sub
'------------------------------------------
Sub Denis()
Dim X As New DataObject
Dim IE As Object
Dim Adr As String
Dim Adresse As String
Vider_Presse_Papier
Adresse = "1000 st-laurent montréal qc canada"
Adr = "http://www.gpsfrance.net/services/adresse2gps.php"
Set IE = CreateObject("internetexplorer.application")
IE.Visible = True
IE.Navigate (Adr)
Application.Wait Now + TimeValue("00:00:04")
Application.SendKeys "{TAB 9}"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys Adresse
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "{TAB}" & "~"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "{TAB}"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
X.GetFromClipboard
MyVar = X.GetText(1)
Range("A1") = MyVar
Vider_Presse_Papier
Application.Wait Now + TimeValue("00:00:03")
Application.SendKeys "{TAB}"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
X.GetFromClipboard
MyVar = X.GetText(1)
Range("B1") = MyVar
End Sub
'------------------------------------------



"Michel Angelosanto"
Bonjour,

A partir d'Excel, j'essaie de récupérer des données avec IE que je pilote
avec des commandes passées par sendkeys.

Le pb c'est que les commandes sélectionner tout CTRL+A, copier CTRL+C et
coller CTRL+V ne marchent pas ans IE via sendkeys alors que manuellement
tout va bien.

Auriez-vous une idée ? Je vous joins le code dans lequel j'ai mis des pauses
pour voir ce qui se passe (ou plutot ne se passe pas!)

Merci pour votre aide.

Sub interro_coordonnees_gps()
Set ws = VBA.CreateObject("WScript.Shell")
ws.SendKeys "%{TAB}" 'ok on va sur IE
Application.Wait (Now + TimeValue("0:00:01"))
SetURL "http://www.gpsfrance.net/services/adresse2gps.php"
clic 1195, 99 'click sur ok
ws.SendKeys "%{TAB}" 'ok on revient sur Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(1, 2).Copy
ws.SendKeys "%{TAB}" 'ok on passe sur IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 372, 183
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^V" 'pas ok
clic 707, 179 'bouton Convertir en coordonnées GPS
Application.Wait (Now + TimeValue("0:00:05"))
clic 256, 210 'click dans la zone latitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 2).Select
ws.SendKeys "^V" 'ok on est dans Excel
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 416, 210 'click dans la zone longitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 4).Select
ws.SendKeys "^V" 'ok on est dans Excel
End Sub

Michel Angelosanto, Bordeaux, France
MichDenis
Le #19925581
Bonjour Michel,

Comme on ne peut pas utiliser les moyens habituels
de programmation, il faut s'aider un peu ! Pour ce
faire, Excel est déjà ouvert, moi, je l'ai mis à l'adresse
suivante : http://mail.live.com/
et afin de m'assurer que la procédure débute toujours
dans la même séquence, je sélectionne l'adresse dans
la boîte d'adresse d'internet explorer.

Dans la procédure "Activer la fenêtre", tu dois définir
cette variable avec ce que l'application "internet explorer"
affiche dans sa barre de titre... mais c'est ce que j'ai ...
Voir_Fenêtre = "Windows Live Hotmail - Windows Internet Explorer"

Dans la procédure, tu dois définir le nom de la feuille et de la
plage de cellules où sont situées tes adresses. Moi j'ai retenu
range("A1:A3") . La latitude s'inscrit dans la colonne B et la
longitude dans la colonne C sur la même ligne que l'adresse.

à 2 endroits dans le code, tu as un ligne de code comme suit :
Application.SendKeys "{TAB 9}" et Application.SendKeys "{TAB 13}"
Les numéros 9 et 13 sont probablement différents dans ton
environnement. Proablement plus près de 4 à 6 et de 8 à 10.
C'est à toi de tester.

Les délais par Application.Wait() sont plutôt longs... cela dépend
de la machine. Ça roule lentement, mais cela fait le travail tout seul.

Tu places tout ce qui suit dans un module standard.
Déclaration des API dans le haut du module
'----------------------------------------------------------
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Public Const SW_NORMAL = 1
'----------------------------------------------------------
Sub Activer_Voir_Fenêtre()
Dim hwnd As Long, Voir_Fenêtre As String

Voir_Fenêtre = "Windows Live Hotmail - Windows Internet Explorer"
hwnd = FindWindow(vbNullString, Voir_Fenêtre)

If hwnd = 0 Then Exit Sub
SetForegroundWindow hwnd
ShowWindow hwnd, SW_NORMAL
End Sub
'----------------------------------------------------------
Sub Vider_Presse_Papier()
OpenClipboard 0
EmptyClipboard
CloseClipboard
End Sub
'----------------------------------------------------------
Sub Denis()
Dim C As Range
Dim X As New DataObject
Dim IE As Object
Dim Adr As String
Dim Adresse As String

Vider_Presse_Papier
Activer_Voir_Fenêtre

Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "http://www.gpsfrance.net/services/adresse2gps.php"
Application.Wait Now + TimeValue("00:00:02")
SendKeys "~"
Application.Wait Now + TimeValue("00:00:04")
Application.SendKeys "{TAB 9}"
Application.Wait Now + TimeValue("00:00:02")

With worksheets("Feuil") 'Nom de la feuille à adapter
For Each C In .range("A1:A3") 'Plage à adapter
Adresse = C.Value
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys Adresse
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "{TAB}" & "~"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "{TAB}"
Application.Wait Now + TimeValue("00:00:03")
Application.SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
X.GetFromClipboard
MyVar = X.GetText(1)
C.Offset(, 1).Value = MyVar
Vider_Presse_Papier
Application.Wait Now + TimeValue("00:00:03")
Application.SendKeys "{TAB}"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
X.GetFromClipboard
MyVar = X.GetText(1)
C.Offset(, 2).Value = MyVar
Vider_Presse_Papier
Application.Wait Now + TimeValue("00:00:01")
Application.SendKeys "{TAB 13}"
Application.Wait Now + TimeValue("00:00:02")
End With
Next
End Sub
'----------------------------------------------------------



"Michel Angelosanto"
Bonjour,

A partir d'Excel, j'essaie de récupérer des données avec IE que je pilote
avec des commandes passées par sendkeys.

Le pb c'est que les commandes sélectionner tout CTRL+A, copier CTRL+C et
coller CTRL+V ne marchent pas ans IE via sendkeys alors que manuellement
tout va bien.

Auriez-vous une idée ? Je vous joins le code dans lequel j'ai mis des pauses
pour voir ce qui se passe (ou plutot ne se passe pas!)

Merci pour votre aide.

Sub interro_coordonnees_gps()
Set ws = VBA.CreateObject("WScript.Shell")
ws.SendKeys "%{TAB}" 'ok on va sur IE
Application.Wait (Now + TimeValue("0:00:01"))
SetURL "http://www.gpsfrance.net/services/adresse2gps.php"
clic 1195, 99 'click sur ok
ws.SendKeys "%{TAB}" 'ok on revient sur Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(1, 2).Copy
ws.SendKeys "%{TAB}" 'ok on passe sur IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 372, 183
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^V" 'pas ok
clic 707, 179 'bouton Convertir en coordonnées GPS
Application.Wait (Now + TimeValue("0:00:05"))
clic 256, 210 'click dans la zone latitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 2).Select
ws.SendKeys "^V" 'ok on est dans Excel
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à IE
Application.Wait (Now + TimeValue("0:00:05"))
clic 416, 210 'click dans la zone longitude
ws.SendKeys "^A" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "^C" 'pas ok
Application.Wait (Now + TimeValue("0:00:01"))
ws.SendKeys "%{TAB}" 'ok on passe à Excel
Application.Wait (Now + TimeValue("0:00:05"))
Cells(2, 4).Select
ws.SendKeys "^V" 'ok on est dans Excel
End Sub

Michel Angelosanto, Bordeaux, France
Michel Angelosanto
Le #19929551
Bonjour MichDenis,

Tu as fait un super travail et je t'en remercie.
En ce qui concerne le problème que je rencontrais avec les sendkeys, j'ai
trouvé une solution qui marche sur Internet.
Cela consiste à mettre les sendkeys dans des procédures différentes, une par
procédure car il semblerait effectivement que toutes les commandes sendkeys
s'exécutent à la suite indépendamment des autres lignes de code.
Mon prog a tourné toute la journée car j'ai beaucoup d'adresses à récupérer.
J'ai remplacé les ctrl+A (sélectionner tout, par des triple clic)
Je vais comparer la rapidité avec ton code car vu le volume, la rapidité est
primordiale. Pour l'instant, il me faut 6 secondes par adresse.

Bon week-end.

"MichDenis" news:
Bonjour Michel,

Comme on ne peut pas utiliser les moyens habituels
de programmation, il faut s'aider un peu ! Pour ce
faire, Excel est déjà ouvert, moi, je l'ai mis à l'adresse
suivante : http://mail.live.com/
et afin de m'assurer que la procédure débute toujours
dans la même séquence, je sélectionne l'adresse dans
la boîte d'adresse d'internet explorer.

Dans la procédure "Activer la fenêtre", tu dois définir
cette variable avec ce que l'application "internet explorer"
affiche dans sa barre de titre... mais c'est ce que j'ai ...
Voir_Fenêtre = "Windows Live Hotmail - Windows Internet Explorer"

Dans la procédure, tu dois définir le nom de la feuille et de la
plage de cellules où sont situées tes adresses. Moi j'ai retenu
range("A1:A3") . La latitude s'inscrit dans la colonne B et la
longitude dans la colonne C sur la même ligne que l'adresse.

à 2 endroits dans le code, tu as un ligne de code comme suit :
Application.SendKeys "{TAB 9}" et Application.SendKeys "{TAB 13}"
Les numéros 9 et 13 sont probablement différents dans ton
environnement. Proablement plus près de 4 à 6 et de 8 à 10.
C'est à toi de tester.

Les délais par Application.Wait() sont plutôt longs... cela dépend
de la machine. Ça roule lentement, mais cela fait le travail tout seul.

Tu places tout ce qui suit dans un module standard.
Déclaration des API dans le haut du module
'----------------------------------------------------------
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Public Const SW_NORMAL = 1
'----------------------------------------------------------
Sub Activer_Voir_Fenêtre()
Dim hwnd As Long, Voir_Fenêtre As String

Voir_Fenêtre = "Windows Live Hotmail - Windows Internet Explorer"
hwnd = FindWindow(vbNullString, Voir_Fenêtre)

If hwnd = 0 Then Exit Sub
SetForegroundWindow hwnd
ShowWindow hwnd, SW_NORMAL
End Sub
'----------------------------------------------------------
Sub Vider_Presse_Papier()
OpenClipboard 0
EmptyClipboard
CloseClipboard
End Sub
'----------------------------------------------------------
Sub Denis()
Dim C As Range
Dim X As New DataObject
Dim IE As Object
Dim Adr As String
Dim Adresse As String

Vider_Presse_Papier
Activer_Voir_Fenêtre

Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "http://www.gpsfrance.net/services/adresse2gps.php"
Application.Wait Now + TimeValue("00:00:02")
SendKeys "~"
Application.Wait Now + TimeValue("00:00:04")
Application.SendKeys "{TAB 9}"
Application.Wait Now + TimeValue("00:00:02")

With worksheets("Feuil") 'Nom de la feuille à adapter
For Each C In .range("A1:A3") 'Plage à adapter
Adresse = C.Value
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys Adresse
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "{TAB}" & "~"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "{TAB}"
Application.Wait Now + TimeValue("00:00:03")
Application.SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
X.GetFromClipboard
MyVar = X.GetText(1)
C.Offset(, 1).Value = MyVar
Vider_Presse_Papier
Application.Wait Now + TimeValue("00:00:03")
Application.SendKeys "{TAB}"
Application.Wait Now + TimeValue("00:00:02")
Application.SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
X.GetFromClipboard
MyVar = X.GetText(1)
C.Offset(, 2).Value = MyVar
Vider_Presse_Papier
Application.Wait Now + TimeValue("00:00:01")
Application.SendKeys "{TAB 13}"
Application.Wait Now + TimeValue("00:00:02")
End With
Next
End Sub
'----------------------------------------------------------


MichDenis
Le #19930291
| Pour l'instant, il me faut 6 secondes par adresse.

**** Pourquoi ne pas publier le code que tu utilises ici ?
Question d'en faire bénéficier les amis !

Pour le plaisir, j'ai regardé ce qu'il était possible de faire
pour améliorer la vitesse ....
Le résultat obtenir est de moins de 2.6 secondes par adresse
en moyenne en utilisant un tableau de 10 adresses. Le chronomètre
débutait avec l'entrée de la boucle jusqu'à la fin. Évidemment, ce
résultat dépend de la puissance de la machine et de la bande passante
de la connexion internet. De plus, afin d'assurer la stabilité de la procédure
il faut lui laisser une certaine marge à l'exécution !

Préconditions pour l'exécution de la procédure :
A ) Ajouter la référence : "Microsoft Forms 2.0 Object Library"
B ) Internet Explorer doit être ouvert
C ) Dans la procédure "Activer la fenêtre", tu dois définir
cette variable "Voir_Fenêtre " avec ce que l'application
"internet explorer" affiche dans sa barre de titre... En
affichant l'adresse "http://mail.live.com/", la barre de titre
affiche :
Voir_Fenêtre = "Windows Live Hotmail - Windows Internet Explorer"
D ) Je mets l'adresse de la barre d'adresse d'internet explorer en surbrillance !
E ) Maintenant, je suis prêt pour lancer la procédure...

Voici, ce que j'ai utilisé :
'Déclaration dans le haut du module
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Public Const SW_NORMAL = 1

Sub Activer_Voir_Fenêtre()
Dim hwnd As Long, Voir_Fenêtre As String

Voir_Fenêtre = "Windows Live Hotmail - Windows Internet Explorer"
hwnd = FindWindow(vbNullString, Voir_Fenêtre)

If hwnd = 0 Then Exit Sub
SetForegroundWindow hwnd
ShowWindow hwnd, SW_NORMAL
End Sub
'------------------------------------
Sub Vider_Presse_Papier()
OpenClipboard 0
EmptyClipboard
CloseClipboard
End Sub
'------------------------------------
Sub Denis()
Dim C As Range
Dim X As New DataObject

Vider_Presse_Papier
Activer_Voir_Fenêtre
Temps_Mort 1 / 2
SendKeys "http://www.gpsfrance.net/services/adresse2gps.php"
Temps_Mort 1 / 2
SendKeys "~"
Temps_Mort 3
Application.SendKeys "{TAB 9}"
Temps_Mort 1
With Worksheets("Feuil")
For Each C In .Range("A1:A10")
Application.SendKeys C.Value
Temps_Mort 1 / 3
Application.SendKeys "{TAB}" & "~"
Temps_Mort 1 / 3
Application.SendKeys "{TAB}"
Temps_Mort 1 / 4
Application.SendKeys "^c"
Temps_Mort 1 / 4
X.GetFromClipboard
C.Offset(, 1).Value = X.GetText(1)
Vider_Presse_Papier
Temps_Mort 1 / 4
Application.SendKeys "{TAB}"
Temps_Mort 1 / 4
Application.SendKeys "^c"
Temps_Mort 1 / 4
X.GetFromClipboard
C.Offset(, 2).Value = X.GetText(1)
Vider_Presse_Papier
Temps_Mort 1 / 4
Application.SendKeys "{TAB 13}"
Temps_Mort 1 / 4
Next
End With
End Sub
'------------------------------------
Sub Temps_Mort(d As Double)
X = Timer + d
Do While Timer <= X
DoEvents
Loop
End Sub
'------------------------------------
Michel Angelosanto
Le #19976661
il suffit de créer des procedures du style

sub entree()
sendkeys "{ENTER}",true
end sub


"MichDenis" news:
| Pour l'instant, il me faut 6 secondes par adresse.

**** Pourquoi ne pas publier le code que tu utilises ici ?
Question d'en faire bénéficier les amis !




Michel Angelosanto, Bordeaux, France
MichDenis
Le #19981581
Juste pour le plaisir avec la procédure déjà publiée,
j'ai réussi un temps moyen de moins de 1.5 secondes
par entrée pour 20 adresses.


"Michel Angelosanto"
il suffit de créer des procedures du style

sub entree()
sendkeys "{ENTER}",true
end sub


"MichDenis" news:
| Pour l'instant, il me faut 6 secondes par adresse.

**** Pourquoi ne pas publier le code que tu utilises ici ?
Question d'en faire bénéficier les amis !




Michel Angelosanto, Bordeaux, France
Publicité
Poster une réponse
Anonyme