Modification d'une macro

Bonjour

Pouvez vous me modifier le code car je n'utilise pas internet explorer et je voudrais que ca ouvre chrome directement. Merci pour votre aide.

Public AdCible As String
Sub CelGMaps()
AdDep = "": AdArr = ""
Form = Application.Caller
Cel = ActiveSheet.Shapes(Form).BottomRightCell.Address
If InStr(1, Form, "gauche") > 0 Then AdCible = Range(Cel).Offset(, -1) Else AdCible = Range(Cel).Offset(, 1)
AdCible = Replace(AdCible, " ", "+")
AppelGMaps
End Sub
Sub AppelGMaps()
Dim IE, IEdoc, elem As Object

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

IE.Navigate ("https://Google.com/maps/place/" & AdCible & ".htm")

Do Until IE.ReadyState = 4 '<>4 or IE.Busy
DoEvents
Loop
Application.Wait (Now + TimeValue("00:00:01"))
Set IEdoc = IE.document
End Sub

le voici un teste

Public AdCible As String

Sub CelGMaps()
    AdDep = "": AdArr = ""
    Form = Application.Caller
    Cel = ActiveSheet.Shapes(Form).BottomRightCell.Address
    If InStr(1, Form, "gauche") > 0 Then
        AdCible = Range(Cel).Offset(, -1)
    Else
        AdCible = Range(Cel).Offset(, 1)
    End If
    AdCible = Replace(AdCible, " ", "+")
    AppelGMaps
End Sub

Sub AppelGMaps()
    Dim chromePath As String
    Dim URL As String

    ' Chemin d'accès à Chrome
    ' Remplace le texte entre les ////////// par le chemin d'accès à Google Chrome dans ton système
    chromePath = "////////////////"

    ' URL Google Maps avec l'adresse cible
    ' Remplace les ////// par l'URL de Google Maps avec l'adresse que tu veut ouvrir. moi je n'ai pas encore accès pour mettre des liens google
    URL = "////////////////"

    ' Ouvrir Google Maps dans Chrome
    Shell ("""" & chromePath & """" & " -new-tab " & URL)
End Sub

Merci pour la réponse.

Petite question suivant cette réponse: ' Remplacez les guillemets triples par l'URL de Google Maps avec l'adresse cible
URL = "////////////////"

L'adresse cible change suivant celle que je rentre dans la case de la feuille Excel

Ca ouvre bien google map dans chrome mais ca prend pas l'adresse de ma cellule.

Public AdCible As String
Sub CelGMaps()
AdDep = "": AdArr = ""
Form = Application.Caller
Cel = ActiveSheet.Shapes(Form).BottomRightCell.Address
If InStr(1, Form, "gauche") > 0 Then
AdCible = Range(Cel).Offset(, -1)
Else
AdCible = Range(Cel).Offset(, 1)
End If
AdCible = Replace(AdCible, " ", "+")
AppelGMaps
End Sub
Sub AppelGMaps()
Dim chromePath As String
Dim URL As String
chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"
URL = "https://Google.com/maps/place/" & AdCible & ".htm"
Shell ("""" & chromePath & """" & " -new-tab " & URL)
End Sub

donc tu vas avoir les lien dans les case?

je ne comprend pas tu vas appuyer sur quoi aux juste

non juste une adresse postal exemple : 114 Rue des Troènes, 31200 Toulouse

c'est pour un planning transport et les adresse change tout le temps , je te l'envoi. la macro est attribué au flèche verte dans la feuille planning

le voici je l'ai mis sur un nouveaux Excel pour pouvoir mettre le lien ...

je ne peux pas mon ordi bloque la macro

j'ai dépasser 30 publication je peut maintenant envoyer des URL

et n'oublie pas d'écrire les code dans leur emplacement pour mieux les voire

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim chromePath As String
    Dim URL As String

    ' Chemin d'accès à Chrome
    chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"

    If InStr(1, Target.Value, ",") > 0 Then

        URL = "https://www.google.com/maps/place/" & Replace(Target.Value, " ", "+")

        Shell ("""" & chromePath & """" & " -new-tab " & URL)
    End If
End Sub

Sub CelGMaps()
    AdDep = "": AdArr = ""
    Form = Application.Caller
    Cel = ActiveSheet.Shapes(Form).BottomRightCell.Address
    If InStr(1, Form, "gauche") > 0 Then
        AdCible = Range(Cel).Offset(, -1)
    Else
        AdCible = Range(Cel).Offset(, 1)
    End If
    AdCible = Replace(AdCible, " ", "+")
    AppelGMaps
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim chromePath As String
    Dim URL As String

    chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"

    If InStr(1, Target.Value, ",") > 0 Then

        URL = "https://www.google.com/maps/place/" & Replace(Target.Value, " ", "+")

        Shell ("""" & chromePath & """" & " -new-tab " & URL)
    End If
End Sub

erreur de compilation sub ou function non definie

salut

tu l'a mal marqué:

d'abord j'ai pas écrit le sub tu voit la première partie ( tu ne l'écrit pas )

ensuite j'ai un Private Sub et non pas sub donc tu l'a marque dans la feuille directement sans passer par un module. (regarde l'exemple que je t'ai envoyer j'ai pas créer un nouveaux module pour la mettre si tu arrive a l'ouvrir)

si tu ne sais pas dit moi je t'envoi des screen

Désole je n'y arrive pas

tu marque le code dans Visual basic dans la feuille1 ou la feuille dans laquelle tu vas appuyer ou cherché l'adresse

ensuite tu vas marque ça

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim chromePath As String
    Dim URL As String

    ' Chemin d'accès à Chrome
    chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"

    If InStr(1, Target.Value, ",") > 0 Then

        URL = "https://www.google.com/maps/place/" & Replace(Target.Value, " ", "+")

        Shell ("""" & chromePath & """" & " -new-tab " & URL)
    End If
End Sub

ensuite dans l'Excel tu click 2 fois (double click ) sur l'adresse que tu veut .

tu as regardé mon tableau? je rentre des adresse et j'utilise la flèche correspondante à la case pour lancer la macro.

C'est normale qu'il ne fonctionne pas tu a 2 private sub avec le même nom en contant celui que je t'ai passé

celui la efface le il est dans la feuille 10 sauv ret

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("C2")) Is Nothing Then Exit Sub
    affichercalendrier
End Sub

ensuite tu met ce code la

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim chromePath As String
    Dim URL As String

    ' Chemin d'accès à Chrome
    chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"

    If InStr(1, Target.Value, ",") > 0 Then

        URL = "https://www.google.com/maps/place/" & Replace(Target.Value, " ", "+")

        Shell ("""" & chromePath & """" & " -new-tab " & URL)
    End If
End Sub

Bonjour

Ci j'efface celui de la feuille 10 il va me manquer quelque chose?

On peut pas adapter le premier code qui fonctionné très bien avec IE mais ne fonctionne plus depuis EDGE. Idéalement j'aimerais qu'il fonctionne avec chrome mais sinon si on peux l'adapter avec EDGE je suis preneur. Désolé mais ce tableau je l'utilise tout les jours et il est vraiment adapté à mon activité.

avec ce code juste en appuyant la page maps avec l'adresse souvriras directement et on peut pas avoir 2 Worksheet_SelectionChange dans la même pas donc soit tu change de page et tu l'a met dans une autre ou je ne sais pas

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim chromePath As String
    Dim URL As String

    ' Chemin d'accès à Chrome
    chromePath = "C:\Program Files\Google\Chrome\Application\chrome.exe"

    If InStr(1, Target.Value, ",") > 0 Then

        URL = "https://www.google.com/maps/place/" & Replace(Target.Value, " ", "+")

        Shell ("""" & chromePath & """" & " -new-tab " & URL)
    End If
End Sub