Probleme de code

apdf1 · 13 Août 2011

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

mth · 13 Août 2011

Re : Probleme de code

Bonjour,

Essaie avec ceci à la fin:

Code:

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

Bonne journée,

mth

apdf1 · 13 Août 2011

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

mth · 13 Août 2011

Re : Probleme de code

re 🙂

Juste avec un bout de code sans fichier, je ne peux pas tester, donc je te laisse chercher ... (tu trouveras des exemples avec hyperlink.add sur le forum)

Bonne journée,

mth

Staple1600 · 13 Août 2011

Re : Probleme de code

Bonjour le fil, apdf1, mth

A vue de nez

Code:

.Hyperlinks.Add .Cells(1, 0), Address:="mailto:" & TextBox9 &  TextBox10

apdf1 · 13 Août 2011

Re : Probleme de code

Bonjour JM

J'ai un message d'erreur

" erreur definie par l'application ou l'objet

@+

Max

Staple1600 · 13 Août 2011

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

apdf1 · 13 Août 2011

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

Staple1600 · 13 Août 2011

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.

apdf1 · 13 Août 2011

Re : Probleme de code

re,

Oui bien sur mais le probleme est que tu enregistre toujours le même nom ou alors j'ai pas compris!
@+

Staple1600 · 13 Août 2011

Re : Probleme de code

Re

???
Je parlais évidemment de la modif qui se trouve sous: Essayes ainsi

Cela fonctionne avec ce qui est dans mon message précédent 😉

apdf1 · 13 Août 2011

Re : Probleme de code

Re,

regarde j'ai fait un fichier exemple et tu me dit ton avis

@

Staple1600 · 13 Août 2011

Re : Probleme de code

Re

Je viens de te dire que cela fonctionne avec la modif présente dans mon message précédent

Tu l'as essayé au moins ??????

apdf1 · 13 Août 2011

Re : Probleme de code

Re,

Oui mais j'avais envoyer le message avant de le voir
Je te remercie et te souhaite un bon Week end

Max

Probleme de code

apdf1

XLDnaute Impliqué

mth

XLDnaute Barbatruc

apdf1

XLDnaute Impliqué

mth

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

apdf1

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

apdf1

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

apdf1

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

apdf1

XLDnaute Impliqué

Pièces jointes

Staple1600

XLDnaute Barbatruc

apdf1

XLDnaute Impliqué

Discussions similaires

Probleme de code

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency