Exporter dans un nouveau classeur à partir de checkbox
Bonjour à tous le forum!
Je sens que je ne suis pas très loin de la vérité, toute fois j'ai atteins ma limite de compétence; peut-être pourrez-vous m'aider. Je vous expose du mieux possible ce que j'aimerais faire :
J'ai actuellement un userform contenant une ListBox1 et les informations primaires des contacts à partir d'une feuille où toutes les données des contacts se retrouve. À partir de se userform j'ouvre un 2e userform avec des OptionButton ainsi que des CheckBox d'où je veux cocher les données que j'aimerais exporter et que celle-ci ce copie dans un nouveau classeur avec l'entête de colonne bien entendu. Actuellement, avec OptionButton1 j'arrive très bien à exporter les courriels des multiple contact sélectionner dans la ListBox pour envoyer un courriel, mais je galère pour l'exportation dans un nouveau classeur excel et ce selon la sélection des CheckBox.
Je vous met bien entendu le fichier joint et le code ci-bas afin de mieux comprendre :
Private Sub CommandButton_Valider_Click()
On Error Resume Next
If Me.OptionButton1 = False And Me.OptionButton2 = False And Me.OptionButton3 = False And Me.CheckBox1 = False And Me.CheckBox2 = False And Me.CheckBox3 = False And Me.CheckBox4 = False And Me.CheckBox5 = False And Me.CheckBox6 = False And Me.CheckBox7 = False And Me.CheckBox8 = False And Me.CheckBox9 = False And Me.CheckBox10 = False And Me.CheckBox11 = False And Me.CheckBox12 = False And Me.CheckBox13 = False Then MsgBox "Aucun item n'a été sélectionné.": Exit Sub
On Error GoTo 0
If Me.OptionButton1 = True Then
If MsgBox("Êtes-vous certain de vouloir envoyer un courriel à toutes la sélection de la liste?", vbYesNo, "Confirmation") = vbYes Then
Dim LB1() As Variant
Dim C1 As Integer
Dim L1 As String
Dim ObjOutlook As Object
Dim ObjMessage As Object
With UF_Contact.ListBox1
For I = 0 To .ListCount - 1
If .Selected(I) = True Then
C1 = C1 + 1
ReDim Preserve LB1(1 To C1)
LB1(C1) = .Column(5, I)
End If
Next I
End With
L1 = Join(LB1, ";")
Set ObjOutlook = CreateObject("Outlook.Application")
Set ObjMessage = ObjOutlook.createitem(0)
ObjMessage.Display
With ObjMessage
'.To
'.CC
.BCC = L1
.Subject = " | "
'.HTMLBody
End With
Set ObjOutlook = Nothing
Unload Me
Else
End If: Exit Sub
End If
If Me.OptionButton2 = True Then
If MsgBox("Êtes-vous certain de vouloir exporter les informations cochées dans un nouveau classeur Excel?", vbYesNo, "Confirmation") = vbYes Then
Dim LB2() As Variant
Dim C2 As Integer
Dim L2 As String
With UF_Contact.ListBox1
For I = 0 To .ListCount - 1
If .Selected(I) = True Then
C2 = C2 + 1
ReDim Preserve LB2(1 To C2)
'LB2(C2) = .Column(1, I)
End If
Next I
End With
L2 = LB2(C2)
'''''''''''''
Unload Me
Unload UF_Contact
Else
End If: Exit Sub
End If
End SubMerci pour votre aide! :)
Pardon pour le fichier je n'avais pas transmis le bon! Le voici!
Je comprends que mon problème est plus compliquer que je pensais
Hello,
Commençons par le positif : graphiquement tes Userform sont jolis et bien fait.
En revanche en back office c'est une toute autre histoire ...
Pas de commentaires
Des controls apparaissent dans le code alors qu'il n'existent pas
Me.OptionButton3 = FalsePresque qu'aucun control n'est renommé ...
Voila pour les fondamentaux
Maintenant pour le côté un peu + pointilleux : tu veux utiliser un array (LB2), c'est bien, mais il faut bien l'utiliser.
Tu passes cette instruction dans une boucle :
ReDim Preserve LB2(1 To C2)et c'est ici que ça me chagrine ... si tu boucles 1 000 000 de fois tu vas redim ton array aussi
De + je ne vois pas l'intérêt d'un array ou d'un dico ici puisque ton but est de créer un classeur infine... On sait que la manière la + simple pour générer un nouveau classeur est de copier une feuille entière, passe donc tes infos dans un feuille d'export directement
Voici une approche à mettre dans ton bouton valider (concerne uniquement 2 checkbox) :
With UF_Contact.ListBox1
Dim x As Integer
x = 1
For I = 0 To .ListCount - 1
If .Selected(I) = True Then
If CheckBox1 = True Then Sheets("tmp_export").Cells(x, 2) = .List(I, 1)
If CheckBox2 = True Then Sheets("tmp_export").Cells(x, 3) = .List(I, 2)
x=x+1
End If
Next I
End WithElle vaut ce qu'elle vaut mais je n'ai pas envie de réécrire tout ton code ...
Ajoute une feuille "tmp_export" dans ton classeur avec les en-tetes
++
Bonjour,
Pour info., multiposte.
Cdlt.
Bonjour Rag02700!
Tout d'abord, merci beaucoup pour tes conseils!
Ensuite, ton code fonctionne très bien, j'ai pu alors facilement l'adapter à mes besoins, je ne serais comment te remercié!