• Initiateur de la discussion Initiateur de la discussion apdf1
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

apdf1

XLDnaute Impliqué
Bonjour

Voila j'ai un petit problème. J'ai un USF qui enregistre sur deux feuilles du même classeur jusqu'ici tout va bien.
Le seul problème sur la feuille "Liste_Mail" il copie sur la cellule "N2" mais j'aimerais qu'il ajoute une ligne a chaque nouvelle enregistrement.

Ceci est mon code:

Code:
Private Sub CommandButton1_Click()

 Dim Ctrl As Control
    For Each Ctrl In Frame1.Controls
        If Ctrl.Object.Value = True Then
           With Sheets("Adresse")
           L = .Range("C65000").End(xlUp).Row + 1
               Cells(L, 2) = "N° " & LabelID
                Cells(L, 3) = Ctrl.Caption & " " & TextBox1.Value 'nom
                 Cells(L, 4) = TextBox2.Value 'Adresse
         
                   
End With

 With Sheets("Liste_Mail")
                .Range("N65000").End(xlUp).Row 1
                
                  .Range("N2").Value = TextBox9 & "@" & TextBox10  'Email
End With

Je vous remercie par avance de votre aide et vous souhaite une bonne journée

Cordialement

Max
 
Re : Probleme de code

Bonjour mth,

Je te remercie beaucoup juste deux petite modif.
Comment envoyer sur la premiere ligne ?
Et pour que je puisse avoir l'adresse active sur la feuille

j'ai mis ce code
Code:
.Hyperlinks.Add .Cells(1, 0), Address:="mailto:" & "TextBox9 &  TextBox10"

mais message d'erreur."Erreur définie par l'application ou par l'objet"

@+

Max
 
Re : Probleme de code

Re


Essayes ainsi:
.Hyperlinks.Add .Cells(1, 0), "mailto:" & TextBox9 & TextBox10

Pour rappel
: il peut être utile de s'aider de l'enregistreur de macro en cas de souci. 😉
Code:
Sub Macro2()
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "mailto:toto@toto.fr?subject=toto", TextToDisplay:="toto"
End Sub
 
Re : Probleme de code

Re,

Le probleme est que je rentre une adresse complete sur un onglet et sur l'autre je rentre uniquement l'adresse email

Voila le code complet

Code:
Private Sub CommandButton1_Click()

 Dim Ctrl As Control
    For Each Ctrl In Frame1.Controls
        If Ctrl.Object.Value = True Then
           With Sheets("Adresse")
           L = .Range("C65000").End(xlUp).Row + 1
               Cells(L, 2) = "N° " & LabelID
                Cells(L, 3) = Ctrl.Caption & " " & TextBox1.Value 'nom
                 Cells(L, 4) = TextBox2.Value 'Adresse
                  Cells(L, 5) = TextBox3.Value 'CP
                   Cells(L, 6) = TextBox4.Value 'ville
                    'Cells(L, 7) = TextBox5.Value 'Departement
                     Cells(L, 7) = TextBox6.Value 'Tél
                      Cells(L, 8) = TextBox7.Value 'Mobile
                       Cells(L, 9) = TextBox8.Value 'Fax
                        Cells(L, 10) = TextBox9 & "@" & TextBox10  'Email
                   .Hyperlinks.Add .Cells(L, 10), Address:="mailto:" & "TextBox9 &  TextBox10" 'Email actif sur la feuille                 
                   
               End With

              With Sheets("Liste_Mail")
           .Range("N65000").End(xlUp).Offset(1, 0) = TextBox9 & "@" & TextBox10                    End With

@+

Max
 
Re : Probleme de code

Re

Le code c'est bien
Un fichier exemple c'est mieux...

Tu as essayé la modif de mon précédent message ?

EDITION: J'ai pris le temps de tester sur un fichier
Code:
Private Sub CommandButton1_Click()
 Dim Ctrl As Control
    For Each Ctrl In Frame1.Controls
           With Sheets(1)
           L = .Range("C65000").End(xlUp).Row + 1
            .Cells(L, 10) = TextBox1 & "@" & TextBox2  'Email
            .Hyperlinks.Add .Cells(L, 10), Address:="mailto:" & .Cells(L, 10).Text  'Email actif sur la feuille
            End With
Next Ctrl
End Sub

Cela fonctionne.
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
476
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
523
  • Question Question
Microsoft 365 Code VBA
Réponses
10
Affichages
862
Réponses
3
Affichages
672
Réponses
8
Affichages
493
Réponses
2
Affichages
407
Réponses
3
Affichages
300
Retour