Discussion :

[muzard]

Bonjour,
J'ai un tableau avec des adresses mails dans la colonne A (données verrouillées)
J'utilise une macro pour copier une adresse mail.

Par exemple, pour copier adresse mail en A1 je clique sur B1

Code :

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

1
2
3
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveCell.Offset(0, -1).Copy
End Sub

Je souhaiterais pouvoir cliquer sur plusieurs cases afin de sélectionner plusieurs adresses mails de la liste espacées chacune d'un point-virgule (liste de diffusion personnalisée)
Comment modifier ma macro en ce sens ?

Merci pour vos retour

[Fab_de_chez_PERFORM]

Bonjour

je propose de mettre des X dans une autre colonne et d'appliquer quelque chose du genre

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Bouton2_Cliquer()
Dim mail As String
 
Dim rng As Range: Set rng = Application.Range("Feuil3!A2:A5")
Dim i As Integer
For i = 2 To rng.Rows.Count + 1 'le +1 est là car A1 non présent dans rng
 
If Range("B" & i).Value = "X" Then
    If i = 2 Then
    mail = Range("A" & i).Value
    Else
    mail = mail & " ; " & Range("A" & i).Value
    End If
End If
 
Next
 
Range("B1").Value = mail
 
End Sub

La ligne Set rng = Application.Range("Feuil3!A2:A5") est évidemment à adapter

Peut être quelqu'un d'autre pourra donner une solution sans mettre des x ailleurs

[Qwazerty]

Salut

Je peux proposer un truc comme ça, même si personnellement, je ne trouve pas ça très "propre"

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Option Explicit
 
Private strListeDiffusion As String
 
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    'On vérifie que l'on se trouve dans la bonne colonne (peut-être amélioré si tu utilises un tableau structuré, en utilisant Intersect)
    If Target.Column = 1 Then
        'On vérifie que la cellule contient une adresse mail (la vérif peut-être améliorée...)
        If InStr(1, Target.Value, "@") <> 0 Then
            'On annule l'apparition du menu flottant
            Cancel = True
            'On vérifie que l'adresse n'est pas déjà dans la liste de diffusion
            If InStr(1, ";" & strListeDiffusion & ";", ";" & Target.Value & ";") = 0 Then
                'On regarde si un ";" doit être ajouté à la liste
                If strListeDiffusion <> "" Then strListeDiffusion = strListeDiffusion & ";"
                'On ajoute l'adresse mail à la liste de diffusion
                strListeDiffusion = strListeDiffusion & Target.Value
                'Option
                'On affiche la liste de diffusion dans une cellule
                Me.Range("A1").Value = strListeDiffusion
            End If
        End If
    End If
 
End Sub
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 Then
        'On annule le double-click
        Cancel = True
        'On efface la liste de diffusion
        strListeDiffusion = ""
        'Option
        'On affiche la liste de diffusion dans une cellule
        Me.Range("A1").Value = strListeDiffusion
    End If
End Sub

Un clique droit sur l'adresse l'ajoute à la liste, un double clique vide la liste.
Tu récupères ensuite ta liste de diffusion dans la variable strListDiffusion pour faire ton mail et tu vide la variable (ainsi que la cellule A1 si tu as gardé l'option )

++
Qwaz

[muzard]

Hello,

Désolé pour cette réponse et ses remerciements tardifs à Fab et Qwaz pour leur proposition.
J'ai adopté celle de Qwaz dans le classeur "tab1" et cela fonctionne parfaitement.

Bon, je vais faire mon difficile...
En fait, les adresses mails copiées sont sur deux colonnes et protégées pour que les utilisateurs ne fassent pas de bévues.
J'ai donc utilisé les colonnes adjacentes pour qu'ils puissent sélectionner les adresses. (classeur "tab2").

Mais je n'arrive pas à adapter ta macro pour que cela fonctionne.

Un dernier petit coup de main ?

Merci encore pour tout le temps passé sur ce forum et pour vos réponses.

Muzard

[Qwazerty]

Salut

Tu peux essayer comme ça

Code :

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

1
2
3
4
5
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    'On vérifie que l'on se trouve dans la bonne colonne (peut-être amélioré si tu utilises un tableau structuré, en utilisant Intersect)
    If Target.Column = 2 Or Target.Column = 4 Then
        'On vérifie que la cellule contient une adresse mail (la vérif peut-être améliorée...)
        If InStr(1, Target.Offset(0, -1).Value, "@") <> 0 Then

++
Qwaz

[muzard]

Super
Après quelques tâtonnements, ça marche nickel ! Un grand grand merci Qwaz