Option Explicit
'-----------------
'UserForm Activate
'-----------------
Private Sub UserForm_Activate()
Dim i As Integer
'Chargement ListBox1
With ActiveWorkbook
For i = 6 To .Sheets.Count
If .Sheets(i).Visible = True Then Me.ListBox1.AddItem .Sheets(i).Name
Next i
End With
Call TriListBox(Me.ListBox1)
'MultiSelect ListBox1 & ListBox2
Me.ListBox1.MultiSelect = fmMultiSelectExtended
Me.ListBox2.MultiSelect = fmMultiSelectExtended
End Sub
'-------------------------------
'Quitter le UseForm ufExportPPAP
'-------------------------------
Sub cbQuitter_Click()
Unload Me
End Sub
'------------------------------------------------------
'Transferer les Items PPAP de la ListBox1 vers ListBox2
'------------------------------------------------------
Sub cbTransferer_Click()
Call TransférerItems(Me.ListBox1, Me.ListBox2)
Me.TextBox1 = Me.ListBox2.ListCount
End Sub
'------------------------------------------------------
'Transferer les Items PPAP de la ListBox2 vers ListBox1
'------------------------------------------------------
Sub cbRetirer_Click()
Call TransférerItems(Me.ListBox2, Me.ListBox1)
Me.TextBox1 = Me.ListBox2.ListCount
End Sub
'----------------------------------------------------
'Imprimer en format pdf les items PPAP de la ListBox2
'----------------------------------------------------
Sub cbImprimer_Click()
Dim i As Integer
Dim k As Integer
Dim TOS() As Variant
For i = 0 To Me.ListBox2.ListCount - 1
ListBox2.Selected(i) = True
Next i
With Me.ListBox2
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
ReDim Preserve TOS(k)
TOS(k) = .List(i)
k = k + 1
End If
Next i
End With
If k = 0 Then
MsgBox "Veuillez choisir au moins un onglet"
Else
Sheets(TOS).Select
End If
Call Module1.Export_PDF
End Sub
'--------------------------------------------------------------------------------
'Transférer les items sélectionnés de la ListBoxSource vers la ListBoxDestination
'--------------------------------------------------------------------------------
Sub TransférerItems(ListBoxSource As MSForms.ListBox, ListBoxDestination As MSForms.ListBox)
Dim i As Integer
If ListBoxSource.ListCount = 0 Then Exit Sub
'Ajoute les items sélectionnés de ListBoxSource dans ListBoxDestination
For i = 0 To ListBoxSource.ListCount - 1
If ListBoxSource.Selected(i) Then
ListBoxDestination.AddItem ListBoxSource.List(i)
End If
Next i
'Retire les items sélectionnés de ListBoxSource
For i = ListBoxSource.ListCount - 1 To 0 Step -1
If ListBoxSource.Selected(i) Then
ListBoxSource.RemoveItem (i)
End If
Next i
Call TriListBox(ListBoxSource)
Call TriListBox(ListBoxDestination)
End Sub
'---------------------------
'Tri des items d'une ListBox
'---------------------------
Sub TriListBox(ListBox As MSForms.ListBox)
Dim i As Integer
Dim TabListBoxItems() As Variant
If ListBox.ListCount = 0 Then Exit Sub
'TabListBoxItems = ListBox.List NON car génère un tableau à 2 dimensions !?
ReDim TabListBoxItems(0 To ListBox.ListCount - 1)
For i = 0 To ListBox.ListCount - 1
TabListBoxItems(i) = ListBox.List(i)
Next i
'MsgBox "Nb items = " & UBound(TabListBoxItems) - LBound(TabListBoxItems) + 1
Call TriT1D(TabListBoxItems, LBound(TabListBoxItems), UBound(TabListBoxItems))
ListBox.List = TabListBoxItems
End Sub
'-------------------------------------------------------
'Tri QuickSort Boisgontier
'http://boisgontierj.free.fr/pages_site/tableaux.htm#Tri
'Exemple: Call TriT1D(t, LBound(t), UBound(t))
'-------------------------------------------------------
Sub TriT1D(a, gauc, droi, Optional sens = 1) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
If sens > 0 Then
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
Else
Do While a(g) > ref: g = g + 1: Loop
Do While ref > a(d): d = d - 1: Loop
End If
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call TriT1D(a, g, droi, sens)
If gauc < d Then Call TriT1D(a, gauc, d, sens)
End Sub