intégrer deux macro en une

Le
Daniel
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 FilesGarminRouteRoute.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
  • Partager ce contenu :
Vos réponses
Trier par : date / pertinence
PMO
Le #3303271
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





Daniel
Le #3561631
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







Poster une réponse
Anonyme