Dim f
Private Sub UserForm_Initialize()
Me.Source.MultiSelect = fmMultiSelectMulti
Set f = Sheets("feuil1")
Me.ListBox1.List = Array("Inscription", "Départ PC", "Entrée cavité", "Sort cavité", "retour pc")
Me.ListBox1.ListIndex = 0
Me.Destination.Caption = Me.ListBox1.List(0)
p = Me.ListBox1.ListIndex
n = f.[A65000].Offset(, p * 3).End(xlUp).Row
If n > 1 Then Me.Source.List = f.Range("A2:B" & n).Offset(, p * 3).Value Else Me.Source.Clear
n = f.[D65000].Offset(, p * 3).End(xlUp).Row
If n > 1 Then Me.Dest.List = f.Range("D2:E" & n).Offset(, p * 3).Value Else Me.Dest.Clear
End Sub
Private Sub ListBox1_Click()
Me.Destination.Caption = Me.ListBox1
p = Me.ListBox1.ListIndex
n = f.[A65000].Offset(, p * 3).End(xlUp).Row
If n > 1 Then Me.Source.List = f.Range("A2:B" & n).Offset(, p * 3).Value Else Me.Source.Clear
n = f.[D65000].Offset(, p * 3).End(xlUp).Row
If n > 1 Then Me.Dest.List = f.Range("D2:E" & n).Offset(, p * 3).Value Else Me.Dest.Clear
End Sub
Private Sub B_enlève_Click()
If Me.Dest.ListCount > 0 And Me.Dest.ListIndex <> -1 Then
Me.Source.AddItem Me.Dest
pos = Me.Source.ListCount - 1
Me.Source.List(pos, 1) = Me.Dest.Column(1)
Me.Dest.RemoveItem Me.Dest.ListIndex
End If
End Sub
Private Sub b_prend_Click()
If Me.Source.ListIndex <> -1 And Me.Source.ListCount > 0 Then
For i = 0 To Me.Source.ListCount - 1
If Me.Source.Selected(i) = True Then
Me.Dest.AddItem Me.Source.List(i)
pos = Me.Dest.ListCount - 1
Me.Dest.List(pos, 1) = Me.Source.List(i, 1)
End If
Next i
For i = Me.Source.ListCount - 1 To 0 Step -1
If Me.Source.Selected(i) = True Then Me.Source.RemoveItem i
Next i
End If
End Sub
Private Sub B_transfert_Click()
p = Me.ListBox1.ListIndex
n = Me.Dest.ListCount
f.[D2].Offset(, p * 3).Resize(25, 2).ClearContents
If n > 0 Then f.[D2].Offset(, p * 3).Resize(n, 2) = Me.Dest.List
n = Me.Source.ListCount
f.[A2].Offset(, p * 3).Resize(25, 2).ClearContents
If n > 0 Then f.[A2].Offset(, p * 3).Resize(n, 2) = Me.Source.List
End Sub