1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109
| Option Explicit
Private H As Double
Private H_Liste As Double
Private ListIndexEnCours As Long
Private Feuille As Worksheet
Private Rng As Range
Private Const NOM_TEXTBOX As String = "newTB"
Private Sub ListBox1_Click()
Dim i As Long
If Enable_Events Then Exit Sub
For i = 0 To ListBox1.ColumnCount - 1
Me.Controls(NOM_TEXTBOX & SEP & i + 1).Text = ListBox1.List(ListBox1.ListIndex, i)
Next i
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim rep As Integer
rep = MsgBox("Voulez-vous supprimer cette ligne?", vbYesNo + vbQuestion)
If ListBox1.ListIndex > -1 Then
If rep = vbYes Then maListe.RemoveItem (ListBox1.ListIndex)
ListBox1.ListIndex = -1
ListBox1.Height = H_Liste
ListIndexEnCours = ListBox1.ListIndex
End If
End Sub
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
If ListBox1.Height = H_Liste Then ListBox1.Height = ListBox1.Height - H
If ListBox1.ListIndex = ListIndexEnCours Then
ListBox1.ListIndex = -1
ListBox1.Height = H_Liste
ListIndexEnCours = ListBox1.ListIndex
Else
ListIndexEnCours = ListBox1.ListIndex
End If
ElseIf Button = 2 Then
If ListBox1.Height = H_Liste Then ListBox1.Height = ListBox1.Height - H
ListBox1.AddItem
Enable_Events = True
ListBox1.ListIndex = ListBox1.ListCount - 1
Enable_Events = False
End If
End Sub
Private Sub UserForm_Activate()
With ListBox1
.ColumnCount = 7
.ColumnWidths = "50;50;100;60;80;50;60"
.RowSource = "Feuil1!A1:G206"
.Width = 490
End With
Add_TextBox Me.ListBox1
End Sub
Private Sub Add_TextBox(Liste As MSForms.ListBox)
Dim i As Long, TextB As Control, ColLeft() As Double, L#
Set maListe = Liste
H_Liste = maListe.Height
With maListe
If .RowSource <> "" Then Remove_RowSource
ReDim ColLeft(.ColumnCount)
ReDim MesTB(.ColumnCount - 1)
ColLeft(0) = 0
For i = 1 To .ColumnCount
ColLeft(i) = Split(Replace(.ColumnWidths, " pt", ""), ";")(i - 1)
Set TextB = Me.Controls.Add("forms.TextBox.1", NOM_TEXTBOX & SEP & i, True)
Set MesTB(i - 1) = New ClasseTB
Set MesTB(i - 1).TBox = TextB
L = L + ColLeft(i - 1): H = TextB.Height
TextB.Move .Left + L, .Top + .Height - TextB.Height, ColLeft(i), H
Next i
End With
End Sub
Private Sub Remove_RowSource()
Dim Source As String, L As Double
Enable_Events = True
With maListe
L = .Width
If InStr(.RowSource, "!") > 0 Then
Set Feuille = Worksheets(Split(.RowSource, "!")(0))
Source = Split(.RowSource, "!")(1)
Else
Source = .RowSource
End If
.RowSource = ""
Set Rng = Range(Source)
.List = Range(Source).Value
.Width = L
End With
Enable_Events = False
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'en cas de rowsource initial : on modifie le Range affecté
If Not Rng Is Nothing Then
If Not Feuille Is Nothing Then
Feuille.Range(Rng.Address).Value = ListBox1.List
Else
Rng.Value = ListBox1.List
End If
End If
End Sub |
Partager