Bonsoir à Tous
Avec cet macro je peut aller voir un endroit sur le globe.
Dans la colonne "AR" il y a un grand liste de point GPS
Ma question est comment intégrée dans cette macro la même fonction
mais sur le programme "nRoute".
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Cancel = True
Dim adresse As String
If Not Intersect(Target, Range("AR2:AR65536")) Is Nothing Then
If Target.Cells.Count = 1 And Target.Value <> "" Then
adresse = "http://maps.google.com/maps?q=" & Target.Offset &
"&t=h&hl=fr"
Internet adresse
End If
End If
End Sub
Ma question est comment intégrée dans cette macro la même fonction
mais sur le programme "nRoute".
pour la déclancher je voudrait faire le double clic dans la colonne
"AQ" (double clic =nRoute).
"AR" (double clic =maps.google.com)
La macros suivante me permet d'ouvrire et de me localiser sur "nRoute".
Sub Traduire_TestCar()
Dim Ligne, Valeur
Dim MyDataObject As DataObject
Dim NomFeuille As String
Donne = ActiveSheet.Name
Application.ScreenUpdating = False
With Worksheets("Test_Car")
.Activate
If Not Intersect(ActiveCell, .Range("a2:H500")) Is Nothing Then
If ActiveCell <> "" Then
ActiveCell.Offset(0, 0).Select
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 9).Copy
MyAppID = Shell("C:\Program Files\Garmin\nRoute\nRoute.exe", 1)
SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la
fenêtre
SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la
fenêtre
SendKeys "{F4}", True ' Envoie la combinaison F4
SendKeys "{home}", True ' Envoie la combinaison w pour catégorie
Waypoints
SendKeys "^g", True
SendKeys "^v", True
SendKeys "{enter}", True
Set Pressp = Nothing
Application.ScreenUpdating = True
End If
End If
End With
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
PMO
Bonjour,
A tout hasard essayez le code suivant
'************************* Const AQ As Long = 43 'colonne "AQ" Const AR As Long = 44 'colonne "AR"
Private Sub Worksheet_BeforeDoubleClick _ (ByVal Target As Range, Cancel As Boolean) Dim col& Dim adresse As String Cancel = True '??? col& = Target.Column If col& = AQ Then If Not Intersect(Target, Range("AQ2:AQ65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & _ "&t=h&hl=fr" Internet adresse 'Appelle votre procédure Internet ??? End If End If ElseIf col& = AR Then Call Traduire_TestCar End If If col& = AQ Then MsgBox adresse 'pour vérif (à jeter) End Sub
'---- pour vérif (à jeter) ---- Sub Traduire_TestCar() MsgBox "j'ai cliqué en colonne ''AR''" & _ et j'appelle la procédure Traduire_TestCar End Sub '*************************
Cordialement. -- PMO Patrick Morange
Bonsoir à Tous Avec cet macro je peut aller voir un endroit sur le globe. Dans la colonne "AR" il y a un grand liste de point GPS Ma question est comment intégrée dans cette macro la même fonction mais sur le programme "nRoute".
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True Dim adresse As String If Not Intersect(Target, Range("AR2:AR65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & "&t=h&hl=fr" Internet adresse End If End If End Sub
Ma question est comment intégrée dans cette macro la même fonction mais sur le programme "nRoute". pour la déclancher je voudrait faire le double clic dans la colonne "AQ" (double clic =nRoute). "AR" (double clic =maps.google.com)
La macros suivante me permet d'ouvrire et de me localiser sur "nRoute".
Sub Traduire_TestCar() Dim Ligne, Valeur Dim MyDataObject As DataObject Dim NomFeuille As String Donne = ActiveSheet.Name Application.ScreenUpdating = False With Worksheets("Test_Car") .Activate If Not Intersect(ActiveCell, .Range("a2:H500")) Is Nothing Then If ActiveCell <> "" Then ActiveCell.Offset(0, 0).Select Selection.End(xlToLeft).Select ActiveCell.Offset(0, 9).Copy MyAppID = Shell("C:Program FilesGarminnRoutenRoute.exe", 1) SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{F4}", True ' Envoie la combinaison F4 SendKeys "{home}", True ' Envoie la combinaison w pour catégorie Waypoints SendKeys "^g", True SendKeys "^v", True SendKeys "{enter}", True Set Pressp = Nothing Application.ScreenUpdating = True End If End If End With End Sub
Bonjour,
A tout hasard essayez le code suivant
'*************************
Const AQ As Long = 43 'colonne "AQ"
Const AR As Long = 44 'colonne "AR"
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
Dim col&
Dim adresse As String
Cancel = True '???
col& = Target.Column
If col& = AQ Then
If Not Intersect(Target, Range("AQ2:AQ65536")) Is Nothing Then
If Target.Cells.Count = 1 And Target.Value <> "" Then
adresse = "http://maps.google.com/maps?q=" & Target.Offset & _
"&t=h&hl=fr"
Internet adresse 'Appelle votre procédure Internet ???
End If
End If
ElseIf col& = AR Then
Call Traduire_TestCar
End If
If col& = AQ Then MsgBox adresse 'pour vérif (à jeter)
End Sub
'---- pour vérif (à jeter) ----
Sub Traduire_TestCar()
MsgBox "j'ai cliqué en colonne ''AR''" & _
et j'appelle la procédure Traduire_TestCar
End Sub
'*************************
Cordialement.
--
PMO
Patrick Morange
Bonsoir à Tous
Avec cet macro je peut aller voir un endroit sur le globe.
Dans la colonne "AR" il y a un grand liste de point GPS
Ma question est comment intégrée dans cette macro la même fonction
mais sur le programme "nRoute".
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Cancel = True
Dim adresse As String
If Not Intersect(Target, Range("AR2:AR65536")) Is Nothing Then
If Target.Cells.Count = 1 And Target.Value <> "" Then
adresse = "http://maps.google.com/maps?q=" & Target.Offset &
"&t=h&hl=fr"
Internet adresse
End If
End If
End Sub
Ma question est comment intégrée dans cette macro la même fonction
mais sur le programme "nRoute".
pour la déclancher je voudrait faire le double clic dans la colonne
"AQ" (double clic =nRoute).
"AR" (double clic =maps.google.com)
La macros suivante me permet d'ouvrire et de me localiser sur "nRoute".
Sub Traduire_TestCar()
Dim Ligne, Valeur
Dim MyDataObject As DataObject
Dim NomFeuille As String
Donne = ActiveSheet.Name
Application.ScreenUpdating = False
With Worksheets("Test_Car")
.Activate
If Not Intersect(ActiveCell, .Range("a2:H500")) Is Nothing Then
If ActiveCell <> "" Then
ActiveCell.Offset(0, 0).Select
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 9).Copy
MyAppID = Shell("C:Program FilesGarminnRoutenRoute.exe", 1)
SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la
fenêtre
SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la
fenêtre
SendKeys "{F4}", True ' Envoie la combinaison F4
SendKeys "{home}", True ' Envoie la combinaison w pour catégorie
Waypoints
SendKeys "^g", True
SendKeys "^v", True
SendKeys "{enter}", True
Set Pressp = Nothing
Application.ScreenUpdating = True
End If
End If
End With
End Sub
'************************* Const AQ As Long = 43 'colonne "AQ" Const AR As Long = 44 'colonne "AR"
Private Sub Worksheet_BeforeDoubleClick _ (ByVal Target As Range, Cancel As Boolean) Dim col& Dim adresse As String Cancel = True '??? col& = Target.Column If col& = AQ Then If Not Intersect(Target, Range("AQ2:AQ65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & _ "&t=h&hl=fr" Internet adresse 'Appelle votre procédure Internet ??? End If End If ElseIf col& = AR Then Call Traduire_TestCar End If If col& = AQ Then MsgBox adresse 'pour vérif (à jeter) End Sub
'---- pour vérif (à jeter) ---- Sub Traduire_TestCar() MsgBox "j'ai cliqué en colonne ''AR''" & _ et j'appelle la procédure Traduire_TestCar End Sub '*************************
Cordialement. -- PMO Patrick Morange
Bonsoir à Tous Avec cet macro je peut aller voir un endroit sur le globe. Dans la colonne "AR" il y a un grand liste de point GPS Ma question est comment intégrée dans cette macro la même fonction mais sur le programme "nRoute".
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True Dim adresse As String If Not Intersect(Target, Range("AR2:AR65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & "&t=h&hl=fr" Internet adresse End If End If End Sub
Ma question est comment intégrée dans cette macro la même fonction mais sur le programme "nRoute". pour la déclancher je voudrait faire le double clic dans la colonne "AQ" (double clic =nRoute). "AR" (double clic =maps.google.com)
La macros suivante me permet d'ouvrire et de me localiser sur "nRoute".
Sub Traduire_TestCar() Dim Ligne, Valeur Dim MyDataObject As DataObject Dim NomFeuille As String Donne = ActiveSheet.Name Application.ScreenUpdating = False With Worksheets("Test_Car") .Activate If Not Intersect(ActiveCell, .Range("a2:H500")) Is Nothing Then If ActiveCell <> "" Then ActiveCell.Offset(0, 0).Select Selection.End(xlToLeft).Select ActiveCell.Offset(0, 9).Copy MyAppID = Shell("C:Program FilesGarminnRoutenRoute.exe", 1) SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{F4}", True ' Envoie la combinaison F4 SendKeys "{home}", True ' Envoie la combinaison w pour catégorie Waypoints SendKeys "^g", True SendKeys "^v", True SendKeys "{enter}", True Set Pressp = Nothing Application.ScreenUpdating = True End If End If End With End Sub
Daniel
Bonjour PMO Je ne trouve pas pourquoi cela ne fonctionne pas avec le double clic. La macros "Sub nRoute_milles()" elle a fonctionne.
Merci Private Sub Worksheet_BeforeDoubleClick _ (ByVal Target As Range, Cancel As Boolean) Dim col& Dim adresse As String Cancel = True '??? col& = Target.Column If col& = AQ Then If Not Intersect(Target, Range("AQ2:AQ65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & _ "&t=h&hl=fr" Internet adresse 'Appelle votre procédure Internet ??? End If End If ElseIf col& = AR Then Call nRoute_milles End If If col& = AQ Then MsgBox adresse 'pour vérif (à jeter) End Sub
Sub nRoute_milles() Dim Ligne, Valeur Dim MyDataObject As DataObject Dim NomFeuille As String Donne = ActiveSheet.Name Application.ScreenUpdating = False With Worksheets("Donne") .Activate If Not Intersect(ActiveCell, .Range("AQ2:AQ65536")) Is Nothing Then If ActiveCell <> "" Then ActiveCell.Offset(0, 1).Copy MyAppID = Shell("C:Program FilesGarminnRoutenRoute.exe", 1) SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{F4}", True ' Envoie la combinaison F4 SendKeys "T", True ' Envoie la combinaison w pour catégorie Waypoints SendKeys "^g", True SendKeys "^v", True SendKeys "{enter}", True Set Pressp = Nothing Application.ScreenUpdating = True End If End If End With End Sub "PMO" <patrickPOINTmorangeAROBASElapostePOINTnet> a écrit dans le message de news:
Bonjour,
A tout hasard essayez le code suivant
'************************* Const AQ As Long = 43 'colonne "AQ" Const AR As Long = 44 'colonne "AR"
Private Sub Worksheet_BeforeDoubleClick _ (ByVal Target As Range, Cancel As Boolean) Dim col& Dim adresse As String Cancel = True '??? col& = Target.Column If col& = AQ Then If Not Intersect(Target, Range("AQ2:AQ65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & _ "&t=h&hl=fr" Internet adresse 'Appelle votre procédure Internet ??? End If End If ElseIf col& = AR Then Call Traduire_TestCar End If If col& = AQ Then MsgBox adresse 'pour vérif (à jeter) End Sub
'---- pour vérif (à jeter) ---- Sub Traduire_TestCar() MsgBox "j'ai cliqué en colonne ''AR''" & _ et j'appelle la procédure Traduire_TestCar End Sub '*************************
Cordialement. -- PMO Patrick Morange
Bonsoir à Tous Avec cet macro je peut aller voir un endroit sur le globe. Dans la colonne "AR" il y a un grand liste de point GPS Ma question est comment intégrée dans cette macro la même fonction mais sur le programme "nRoute".
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True Dim adresse As String If Not Intersect(Target, Range("AR2:AR65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & "&t=h&hl=fr" Internet adresse End If End If End Sub
Ma question est comment intégrée dans cette macro la même fonction mais sur le programme "nRoute". pour la déclancher je voudrait faire le double clic dans la colonne "AQ" (double clic =nRoute). "AR" (double clic =maps.google.com)
La macros suivante me permet d'ouvrire et de me localiser sur "nRoute".
Sub Traduire_TestCar() Dim Ligne, Valeur Dim MyDataObject As DataObject Dim NomFeuille As String Donne = ActiveSheet.Name Application.ScreenUpdating = False With Worksheets("Test_Car") .Activate If Not Intersect(ActiveCell, .Range("a2:H500")) Is Nothing Then If ActiveCell <> "" Then ActiveCell.Offset(0, 0).Select Selection.End(xlToLeft).Select ActiveCell.Offset(0, 9).Copy MyAppID = Shell("C:Program FilesGarminnRoutenRoute.exe", 1) SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{F4}", True ' Envoie la combinaison F4 SendKeys "{home}", True ' Envoie la combinaison w pour catégorie Waypoints SendKeys "^g", True SendKeys "^v", True SendKeys "{enter}", True Set Pressp = Nothing Application.ScreenUpdating = True End If End If End With End Sub
Bonjour PMO
Je ne trouve pas pourquoi cela ne fonctionne pas avec le double clic.
La macros "Sub nRoute_milles()" elle a fonctionne.
Merci
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
Dim col&
Dim adresse As String
Cancel = True '???
col& = Target.Column
If col& = AQ Then
If Not Intersect(Target, Range("AQ2:AQ65536")) Is Nothing Then
If Target.Cells.Count = 1 And Target.Value <> "" Then
adresse = "http://maps.google.com/maps?q=" & Target.Offset & _
"&t=h&hl=fr"
Internet adresse 'Appelle votre procédure Internet ???
End If
End If
ElseIf col& = AR Then
Call nRoute_milles
End If
If col& = AQ Then MsgBox adresse 'pour vérif (à jeter)
End Sub
Sub nRoute_milles()
Dim Ligne, Valeur
Dim MyDataObject As DataObject
Dim NomFeuille As String
Donne = ActiveSheet.Name
Application.ScreenUpdating = False
With Worksheets("Donne")
.Activate
If Not Intersect(ActiveCell, .Range("AQ2:AQ65536")) Is Nothing Then
If ActiveCell <> "" Then
ActiveCell.Offset(0, 1).Copy
MyAppID = Shell("C:Program FilesGarminnRoutenRoute.exe", 1)
SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la
fenêtre
SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la
fenêtre
SendKeys "{F4}", True ' Envoie la combinaison F4
SendKeys "T", True ' Envoie la combinaison w pour catégorie Waypoints
SendKeys "^g", True
SendKeys "^v", True
SendKeys "{enter}", True
Set Pressp = Nothing
Application.ScreenUpdating = True
End If
End If
End With
End Sub
"PMO" <patrickPOINTmorangeAROBASElapostePOINTnet> a écrit dans le message de
news: 3AE1C330-1D26-46BC-80BB-DB4435ABCFD4@microsoft.com...
Bonjour,
A tout hasard essayez le code suivant
'*************************
Const AQ As Long = 43 'colonne "AQ"
Const AR As Long = 44 'colonne "AR"
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
Dim col&
Dim adresse As String
Cancel = True '???
col& = Target.Column
If col& = AQ Then
If Not Intersect(Target, Range("AQ2:AQ65536")) Is Nothing Then
If Target.Cells.Count = 1 And Target.Value <> "" Then
adresse = "http://maps.google.com/maps?q=" & Target.Offset & _
"&t=h&hl=fr"
Internet adresse 'Appelle votre procédure Internet ???
End If
End If
ElseIf col& = AR Then
Call Traduire_TestCar
End If
If col& = AQ Then MsgBox adresse 'pour vérif (à jeter)
End Sub
'---- pour vérif (à jeter) ----
Sub Traduire_TestCar()
MsgBox "j'ai cliqué en colonne ''AR''" & _
et j'appelle la procédure Traduire_TestCar
End Sub
'*************************
Cordialement.
--
PMO
Patrick Morange
Bonsoir à Tous
Avec cet macro je peut aller voir un endroit sur le globe.
Dans la colonne "AR" il y a un grand liste de point GPS
Ma question est comment intégrée dans cette macro la même fonction
mais sur le programme "nRoute".
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Cancel = True
Dim adresse As String
If Not Intersect(Target, Range("AR2:AR65536")) Is Nothing Then
If Target.Cells.Count = 1 And Target.Value <> "" Then
adresse = "http://maps.google.com/maps?q=" & Target.Offset &
"&t=h&hl=fr"
Internet adresse
End If
End If
End Sub
Ma question est comment intégrée dans cette macro la même fonction
mais sur le programme "nRoute".
pour la déclancher je voudrait faire le double clic dans la colonne
"AQ" (double clic =nRoute).
"AR" (double clic =maps.google.com)
La macros suivante me permet d'ouvrire et de me localiser sur "nRoute".
Sub Traduire_TestCar()
Dim Ligne, Valeur
Dim MyDataObject As DataObject
Dim NomFeuille As String
Donne = ActiveSheet.Name
Application.ScreenUpdating = False
With Worksheets("Test_Car")
.Activate
If Not Intersect(ActiveCell, .Range("a2:H500")) Is Nothing Then
If ActiveCell <> "" Then
ActiveCell.Offset(0, 0).Select
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 9).Copy
MyAppID = Shell("C:Program FilesGarminnRoutenRoute.exe", 1)
SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la
fenêtre
SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la
fenêtre
SendKeys "{F4}", True ' Envoie la combinaison F4
SendKeys "{home}", True ' Envoie la combinaison w pour catégorie
Waypoints
SendKeys "^g", True
SendKeys "^v", True
SendKeys "{enter}", True
Set Pressp = Nothing
Application.ScreenUpdating = True
End If
End If
End With
End Sub
Bonjour PMO Je ne trouve pas pourquoi cela ne fonctionne pas avec le double clic. La macros "Sub nRoute_milles()" elle a fonctionne.
Merci Private Sub Worksheet_BeforeDoubleClick _ (ByVal Target As Range, Cancel As Boolean) Dim col& Dim adresse As String Cancel = True '??? col& = Target.Column If col& = AQ Then If Not Intersect(Target, Range("AQ2:AQ65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & _ "&t=h&hl=fr" Internet adresse 'Appelle votre procédure Internet ??? End If End If ElseIf col& = AR Then Call nRoute_milles End If If col& = AQ Then MsgBox adresse 'pour vérif (à jeter) End Sub
Sub nRoute_milles() Dim Ligne, Valeur Dim MyDataObject As DataObject Dim NomFeuille As String Donne = ActiveSheet.Name Application.ScreenUpdating = False With Worksheets("Donne") .Activate If Not Intersect(ActiveCell, .Range("AQ2:AQ65536")) Is Nothing Then If ActiveCell <> "" Then ActiveCell.Offset(0, 1).Copy MyAppID = Shell("C:Program FilesGarminnRoutenRoute.exe", 1) SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{F4}", True ' Envoie la combinaison F4 SendKeys "T", True ' Envoie la combinaison w pour catégorie Waypoints SendKeys "^g", True SendKeys "^v", True SendKeys "{enter}", True Set Pressp = Nothing Application.ScreenUpdating = True End If End If End With End Sub "PMO" <patrickPOINTmorangeAROBASElapostePOINTnet> a écrit dans le message de news:
Bonjour,
A tout hasard essayez le code suivant
'************************* Const AQ As Long = 43 'colonne "AQ" Const AR As Long = 44 'colonne "AR"
Private Sub Worksheet_BeforeDoubleClick _ (ByVal Target As Range, Cancel As Boolean) Dim col& Dim adresse As String Cancel = True '??? col& = Target.Column If col& = AQ Then If Not Intersect(Target, Range("AQ2:AQ65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & _ "&t=h&hl=fr" Internet adresse 'Appelle votre procédure Internet ??? End If End If ElseIf col& = AR Then Call Traduire_TestCar End If If col& = AQ Then MsgBox adresse 'pour vérif (à jeter) End Sub
'---- pour vérif (à jeter) ---- Sub Traduire_TestCar() MsgBox "j'ai cliqué en colonne ''AR''" & _ et j'appelle la procédure Traduire_TestCar End Sub '*************************
Cordialement. -- PMO Patrick Morange
Bonsoir à Tous Avec cet macro je peut aller voir un endroit sur le globe. Dans la colonne "AR" il y a un grand liste de point GPS Ma question est comment intégrée dans cette macro la même fonction mais sur le programme "nRoute".
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True Dim adresse As String If Not Intersect(Target, Range("AR2:AR65536")) Is Nothing Then If Target.Cells.Count = 1 And Target.Value <> "" Then adresse = "http://maps.google.com/maps?q=" & Target.Offset & "&t=h&hl=fr" Internet adresse End If End If End Sub
Ma question est comment intégrée dans cette macro la même fonction mais sur le programme "nRoute". pour la déclancher je voudrait faire le double clic dans la colonne "AQ" (double clic =nRoute). "AR" (double clic =maps.google.com)
La macros suivante me permet d'ouvrire et de me localiser sur "nRoute".
Sub Traduire_TestCar() Dim Ligne, Valeur Dim MyDataObject As DataObject Dim NomFeuille As String Donne = ActiveSheet.Name Application.ScreenUpdating = False With Worksheets("Test_Car") .Activate If Not Intersect(ActiveCell, .Range("a2:H500")) Is Nothing Then If ActiveCell <> "" Then ActiveCell.Offset(0, 0).Select Selection.End(xlToLeft).Select ActiveCell.Offset(0, 9).Copy MyAppID = Shell("C:Program FilesGarminnRoutenRoute.exe", 1) SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{ESC}", True ' Envoie la combinaison escape pour fermé la fenêtre SendKeys "{F4}", True ' Envoie la combinaison F4 SendKeys "{home}", True ' Envoie la combinaison w pour catégorie Waypoints SendKeys "^g", True SendKeys "^v", True SendKeys "{enter}", True Set Pressp = Nothing Application.ScreenUpdating = True End If End If End With End Sub