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 Sub

Merci 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 = False

Presque 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 ... du coup la rapidité de ton array n'a pas l'effet escompté ... Il vaut mieux utiliser un dictionnaire dans ce cas

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 With

Elle 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é!

Rechercher des sujets similaires à "exporter nouveau classeur partir checkbox"