Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel intégrer deux macro en une

intégrer deux macro en une

2 réponses
Avatar
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 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
Signaler un problème avec ce contenu

2 réponses

Supprimer
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
Avatar
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





Avatar
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