[Résolu] Appel macro sous condition

[Lone-wolf]

Bonsoir le Forum,

je n'arrive pas à trouver où insérer dans le code suivant cette syntaxe:

If [H5] = "" Then Call efface

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cel As Range, lig%
On Error Resume Next
If [E5] = "" Then [H5, D9:D13, F9] = "": Exit Sub
If Intersect(Target, [E5]) Is Nothing Then: [H5].Select

If [H5] <> "" Then
[E5].Select
lig = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
If lig < 2 Then Exit Sub
With Sheets(2).Range("a2:a" & lig)
 Set cel = .Find(Range("E5"), LookIn:=xlValues, lookat:=xlWhole)
If Not cel Is Nothing Then
 [D9].Value = cel.Offset(0, 0).Value
 [D10].Value = cel.Offset(0, 1).Value
 [D11].Value = cel.Offset(0, 2).Value & " " & cel.Offset(0, 3).Value
 [D13].Value = cel.Offset(0, 4).Value
Else
[F9].Value = "Pas de résultat pour " & [E5].Value & " à " & [H5].Value
    End If
End With
End If
End Sub

A+ 😎

 

[Fred0o]

Re : Appel macro sous codition

Bonsoir Lone-wolf,

A mon avis, tu peux essayer ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cel As Range, lig%
    On Error Resume Next
    If [E5] = "" Then [H5, D9:D13, F9] = "": Exit Sub
    If Intersect(Target, [E5]) Is Nothing Then: [H5].Select
    If [H5] <> "" Then
        [E5].Select
        lig = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
        If lig < 2 Then Exit Sub
        With Sheets(2).Range("a2:a" & lig)
            Set cel = .Find(Range("E5"), LookIn:=xlValues, lookat:=xlWhole)
            If Not cel Is Nothing Then
                [D9].Value = c.Offset(0, 0).Value
                [D10].Value = c.Offset(0, 1).Value
                [D11].Value = c.Offset(0, 2).Value & " " & c.Offset(0, 3).Value
                [D13].Value = c.Offset(0, 4).Value
            Else
                [F9].Value = "Pas de résultat pour " & [E5].Value & " à " & [H5].Value
            End If
        End With
    Else
        Call Efface
    End If
End Sub

A+

 

[Lone-wolf]

Re : Appel macro sous codition

Bonsoir Fred0o,

merci d'avoir répondu aussi rapidement, je vais testé et te tiens au courant.


A+ 😎

 

[Lone-wolf]

Re : Appel macro sous codition

Re Fed0o,

désolé, ce n'est pas encore ça.

A+ 😎

 

[Fred0o]

Re : Appel macro sous codition

Re-bonsoir,

Au début de ta macro, tu écris :

If [E5] = "" Then [H5, D9:D13, F9] = "": Exit Sub

Donc, si tu veux faire le test avant cette ligne, la macro devient :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cel As Range, lig%
    On Error Resume Next
    If [H5] = "" Then Call Efface
    If [E5] = "" Then [H5, D9:D13, F9] = "": Exit Sub
    If Intersect(Target, [E5]) Is Nothing Then: [H5].Select
    If [H5] <> "" Then
        [E5].Select
        lig = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
        If lig < 2 Then Exit Sub
        With Sheets(2).Range("a2:a" & lig)
            Set cel = .Find(Range("E5"), LookIn:=xlValues, lookat:=xlWhole)
            If Not cel Is Nothing Then
                [D9].Value = c.Offset(0, 0).Value
                [D10].Value = c.Offset(0, 1).Value
                [D11].Value = c.Offset(0, 2).Value & " " & c.Offset(0, 3).Value
                [D13].Value = c.Offset(0, 4).Value
            Else
                [F9].Value = "Pas de résultat pour " & [E5].Value & " à " & [H5].Value
            End If
        End With
    End If
End Sub

Si cela ne fonctionne pas, je ne pense pas pouvoir mieux t'aider sans plus d'explication ou un fichier exemple.

A+

 

[Lone-wolf]

Re : Appel macro sous codition

Re,

désolé pour le petit retard, j'ai du éffacer les données et écrire des noms fictifs.

Voici le fichier.

L'action à exécuter est: après la première recherche, éffacer les données en tapant sur Enter.


A+ 😎

 

[Staple1600]

Re : [Résolu] Appel macro sous codition

Bonsoir à tous

Puisque tu as pris le soin d’anonymiser ton fichier, ne devrais-tu pas aussi ne pas utiliser de logo sous copyright ?
(Ce qui n'enlèverai rien au fonctionnement de ton appli)

Mentions de marque et de droit d'auteur
L'ensemble du contenu du service est soumis au Copyright © 2010 Microsoft Corporation et/ou de ses fournisseurs, One Microsoft Way, Redmond, WA 98052, États-Unis. Tous droits réservés. Nous ou nos fournisseurs sommes les propriétaires et détenons les droits d'auteur et autres droits de propriété intellectuelle du service ou des contenus. Microsoft, Windows, Windows Live, le logo Windows, MSN, le logo MSN (papillon), Bing et les autres produits et services Microsoft peuvent aussi être des marques ou des marques déposées de Microsoft aux États-Unis d'Amérique et/ou dans d'autres pays. Les noms des sociétés et des produits concernés peuvent être des marques de leurs propriétaires respectifs. Tous les droits qui ne sont pas expressément accordés par le présent contrat sont réservés. Certains logiciels utilisés dans un certain nombre de serveurs de sites Web Microsoft reposent, en partie, sur le travail de Independent JPEG Group. Copyright © 1991–1996 Thomas G. Lane. Tous droits réservés. Le logiciel « gnuplot » utilisé dans certains serveurs de sites Web Microsoft est protégé par le droit d'auteur © 1986–1993 Thomas Williams, Colin Kelley. Tous droits réservés.

PS: Sinon une suggestion en passant pour ton code VBA

Sub efface()
Dim arr$, wb As Object
With Feuil1
If .[D10, D11] = "" Then
arr = .[D10]  & " " & .[D11]
Set wb = .WebBrowser1
End With
wb.Navigate "http://maps.google.fr/maps?q=" & arr
End If
End Sub

 

[Lone-wolf]

Re : [Résolu] Appel macro sous codition

Salut Staple,

Beaucoup de maisons paie pour qu'on leur fasse de la pub. Mais si sa peut te rassurer, tous fichiers fait ici ou ailleurs, n'outrepassent pas la porte de mon appart avec ou sans la pub; ça m’étonnerais beaucoup que Microsoft et compagnie me mettent en tôle parce que j'ai mis deux de leurs logos sur un fichier; ils y en a qui font pire, mais beaucoup plus pire que ça; et tu as beaucoup de chance, moi je pourrais tout aussi bien les mettre sur ma voiture ou sur le toit de l'immeuble.

Si ça peut te rendre service tu peux aussi me dénoncer. 😉

A+ : cool:

 

[Staple1600]

Re : [Résolu] Appel macro sous codition

Bonjour

Un logo sous copyright reste un logo sous copyright.

Pas de commentaires sur ma suggestion VBAistique (voir le PS de mon précédent message)

 

[Lone-wolf]

Re : [Résolu] Appel macro sous codition

Re Staple,

et bien, moi j'avait fait comme ceci:

Private Function efface()
Set wb = Feuil1.WebBrowser1
wb.Navigate "http://maps.google.fr/maps?q=" & arr
End Function

Dans tout les cas, je te remercie pour ta proposition.


A+ 😎