Résolu(presque): usf pour extraire selection de feuilles

[papapaul]

Salut le forum,😉

C’est pas grand-chose mais bon,
A force de chercher ici, merci à tous, je pense avoir réussi
un petit usf qui pourra en aider quelques-uns (zip ci-dessous)
Ca permet d’isoler une sélection (mes vrais fichiers
ont plusieurs dizaines de feuilles). Il existe déjà ce genre de
choses mais mon bricolage fonctionne, en tout cas chez moi.
Reste un seul petit hic, si j’active un bouton sans rien avoir
mis dans liste2, évidement ça plante.
Je vais essayer de mettre un msg d’alerte pour éviter ça.
Si vous savez comment faire….😕
Si vous constatez des bugs ou des erreurs, dites le moi
Je débute
Bonne journée les forumeurs

 

[Temjeh]

Re : Résolu(presque): usf pour extraire selection de feuilles

Bonjour

Sous ton bouton après ton nexti

If ListBox1.ListIndex = -1 Then Exit Sub

A+

Temjeh

merci _Thierry j'examine ta façon

 

[_Thierry]

Re : Résolu(presque): usf pour extraire selection de feuilles

Bonjour PapaPaul, Temjeh, le Forum

Oui Temjeh pour la ListBox1, ok pour le check ListIndex, mais pour la ListBox2 c'est plus dangereux commer plantage, "Object Deconnection"...

Je propose ceci :

Option Explicit
 
Private Sub UserForm_Initialize()
Dim c As Worksheet
    For Each c In ActiveWorkbook.Sheets
        ListBox1.AddItem c.Name
    Next
End Sub
 
[B][COLOR=purple]Private Function TheListBox2_Testor() As Boolean[/COLOR][/B][COLOR=purple]
[B]If Me.ListBox2.ListCount = 0 Then[/B]
[B]   MsgBox "Ah non !!! il n'y a rien dans la liste !", vbCritical[/B]
[B]   TheListBox2_Testor = True[/B]
[B]End If[/B][/COLOR]
[B][COLOR=purple]End Function[/COLOR][/B][COLOR=purple]
[/COLOR]
Private Sub CommandButton1_Click()
'Copie plusieurs feuilles pour enregistrer
Dim i As Integer, tmp As Byte
Dim MyArray() As Variant
[B][COLOR=purple]If TheListBox2_Testor = True Then Exit Sub[/COLOR][/B]
    With ListBox2
        For i = 0 To .ListCount - 1
            If .Selected(i) = False Then
                ReDim Preserve MyArray(tmp)
                MyArray(tmp) = ListBox2.List(i)
                tmp = tmp + 1
            End If
        Next
    End With
Worksheets(MyArray).Copy
Application.Dialogs(xlDialogSaveAs).Show
Unload UserForm1
End Sub
 
Private Sub CommandButton2_Click()
'transfert 1 vers 2
Dim i As Integer
If Me.ListBox1.ListIndex = -1 Then Exit Sub [B][COLOR=green]'Gestion d'erreur par sortie...[/COLOR][/B]
    For i = 0 To ListBox2.ListCount - 1
            If ListBox1.Value = ListBox2.List(i) Then
                MsgBox " Feuille déjà sélectionnée ", , "Attention"
                ListBox1.ListIndex = -1
                Exit Sub
            End If
    Next i
ListBox2.AddItem ListBox1.Value
ListBox1.ListIndex = -1
End Sub
 
Private Sub CommandButton3_Click()
'impression des feuilles de la selection listbox2
Dim i As Integer, tmp As Byte
Dim MyArray() As Variant
[B][COLOR=purple]If TheListBox2_Testor = True Then Exit Sub[/COLOR][/B][COLOR=purple]
[/COLOR]   With ListBox2
        For i = 0 To .ListCount - 1
            If .Selected(i) = False Then
                ReDim Preserve MyArray(tmp)
                MyArray(tmp) = ListBox2.List(i)
                tmp = tmp + 1
            End If
        Next
    End With
Worksheets(MyArray).PrintOut
Unload UserForm1
End Sub
 
Private Sub ListBox2_dblClick(ByVal cancel As MSForms.ReturnBoolean)
'Supprime les items erronés de la listbox2
ListBox2.RemoveItem (ListBox2.ListIndex)
End Sub
 
Private Sub OptionButton1_Click()
Dim i As Integer
    With ActiveWorkbook
        ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "liste des feuilles"
        Worksheets("liste des feuilles").Move
            For i = 1 To .Sheets.Count
                Cells(1, 1).Value = "Sommaire"
                Cells(i + 4, 1).Value = .Sheets(i).Name
            Next i
    End With
Unload UserForm1
End Sub
 
Private Sub OptionButton2_Click()
Dim i As Integer, j As Integer
[B][COLOR=purple]If TheListBox2_Testor = True Then Exit Sub[/COLOR][/B]
 
Worksheets.Add after:=Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Name = "liste des feuilles"
Worksheets("liste des feuilles").Move
j = 1
    With ListBox2
        For i = 0 To .ListCount - 1
            Cells(1, 1).Value = "Sommaire"
            Cells(j + 4, 1) = .List(i, 0): Cells(j, 5) = .List(i, 1)
            j = j + 1
        Next
    End With
Unload UserForm1
End Sub

Bon App

@+Thierry

​

 

[papapaul]

Re : Résolu(presque): usf pour extraire selection de feuilles

Merci beaucoup les amis

Je vois que Thierry a bien étudié mon souci, merci à lui

Je connais pas encore les private function mais
je vais tester tout ca ce soir. Encore merci

🙂 Je vous dirais si tout va bien

 

[papapaul]

Re : Résolu(presque): usf pour extraire selection de feuilles

🙂

J'ai pas pu resister, j'ai tester tout de suite

faut pas le dire à la patronne 😱 (lol), elle rouspete tout le temps

En tout cas ca marche IMPEC, quand je pense que j'ai
mis des heures et des heures à faire mes bidouilles

Merci beaucoup

J'ai d'autres truc en route, (copie de ligne en fonction de certains
codes et selon des conditions vers une seule feuille recap....)
Mais je vais essayer tout seul, ca m'occupe trop bien les nuits 😉

Je ferai appel aux pros si je rame trop.

Bravo le forum

@+ 🙂