Discussion :

[__JB__]

Bonjour,

Je viens de créer un fichier qui, une fois complété par une personne, va intéresser une ou plusieurs autres personnes.
Il convient donc de les informer de la création ou de la mise à jour de ce fichier partagé sur le réseau.

Je souhaite donc faciliter l'envoi (presque) automatique d'un mail pré-rempli aux utilisateurs sélectionnés (nous utilisons Zimbra).

Pour cela, j'ai utilisé la fonction suivante :

Code formule :

Sélectionner tout - Visualiser dans une fenêtre à part

=LIEN_HYPERTEXTE("mailto:"&D11&"?cc="&D12&"&subject="&D13&"&body="&D14;"envoyer le mail")

Mon soucis, c'est D11 et D12 sont "fixes" et que j'aimerai pouvoir, à partir d'une liste ajouter d'autres adresses si nécessaire.
A mon niveau, facile s'il n'y a qu'une personne, mais comment créer une macro qui ajouterait à la cellule D11 l'adresse mail 001@xxx.com si D11 n'est pas vide et contient déjà une autre adresse mail ?
Si D11 n'est pas vide, il faudrait conserver l'adresse déjà présente, en séparant par ";"

Les adresses sont dispo dans un tableau H9:I46 qui comprend nom prénom en colonne H puis l'adresse correspondante en colonne I.

Je ne sais pas si ma demande est très claire...

Merci aux bonnes volontés qui pourront me proposer des pistes !

JiBé

[BENNASR]

bonjour
je sais pas si j'ai compris la demande
mais voila un code si tu te mets sur l'adresse souhaité et tu fais clic droite souris, l'adresse s'ajoute en D11

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("I9:I46")) Is Nothing Then
    If Range("D11") = "" Then
      Range("D11") = ActiveCell.Value
      Else
       Range("D11") = Range("D11") & ";" & ActiveCell.Value
    End If
    End If
End Sub

[__JB__]

Bonjour BENNASR,

Merci beaucoup, vous avez tout à fait compris ma demande !!
l'effet est bien celui attendu.

Serait-il possible d'appliquer cette fonction, non pas sur un clic droit, mais en cliquant sur un bouton ?
et dans l'affirmative comment modifier votre proposition initiale ?

cordialement,

[BENNASR]

à tester

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
Dim F1 As Worksheet
Set F1 = Sheets("Feuil1")
If Not Application.Intersect(ActiveCell, F1.Range("I9:I46")) Is Nothing Then
If MsgBox("Etes-vous certain de vouloir ajouter cette adresse ???    " & ActiveCell.Value, vbYesNo, "Demande de confirmation") = vbYes Then
    If F1.Range("D11") = "" Then
      F1.Range("D11") = ActiveCell.Value
      Else
       F1.Range("D11") = Range("D11") & ";" & ActiveCell.Value
    End If
   End If
End If
End Sub

[__JB__]

Merci de cette nouvelle proposition, mais je ne parviens à la faire fonctionner !

j'ai modifié ainsi (en rouge ci dessous) et coller dans un module, affecté la macro à mon bouton, mais il ne se passe rien...
Que dois-je faire d'autre ?

merci de voter patience !!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
Dim F1 As Worksheet
Set F1 = Sheets("Envoi mail")
If Not Application.Intersect(ActiveCell, F1.Range("I9:I46")) Is Nothing Then
If MsgBox("Etes-vous certain de vouloir ajouter cette adresse ?    " & ActiveCell.Value, vbYesNo, "Demande de confirmation") = vbYes Then
    If F1.Range("D11") = "" Then
      F1.Range("D11") = ActiveCell.Value
      Else
       F1.Range("D11") = Range("D11") & ";" & ActiveCell.Value
    End If
   End If
End If
End Sub

[BENNASR]

il faut que tu te positionne sur l'adresse à copier que se trouve dans la plage I9 : I46

[__JB__]

En effet, ça fonctionne parfaitement !

c'est donc résolu, merci beaucoup pour le temps consacré à ma demande !

bonne journée