Bonjour le forum,
Voila j'ai un soucis pour faire une selection multi-lignes dans un listview via des textbox pour modification de champ.
Je souhaite modifier le contenu des cellules lorsque que je fais ma selection multi-lignes avec les textbox correspondantes.
Mon code marche pour une ligne mais pas pour plusieurs...
Si vous voulez un fichier exemple faite moi signe
sinon voila le code:
Merci et à bientot
Vassili
Voila j'ai un soucis pour faire une selection multi-lignes dans un listview via des textbox pour modification de champ.
Je souhaite modifier le contenu des cellules lorsque que je fais ma selection multi-lignes avec les textbox correspondantes.
Mon code marche pour une ligne mais pas pour plusieurs...
Si vous voulez un fichier exemple faite moi signe
sinon voila le code:
Merci et à bientot
Vassili
Code:
Option Explicit
Dim Y As Integer
Dim Tabtemp As Variant
Dim Lgn As Integer
Dim Col As Byte
Dim Derligne As Integer
Dim flag As Boolean
Dim ligne1 As Long
Dim i As Long, j As Integer
Dim data1me As String
Dim nomfeuille1 As String
Dim lignetitre As Long
Dim dc1 As Long ' dernière ligne
Dim trouve As Boolean
Dim nbelement As Integer
Dim coldepart As Integer
Dim coln As String
Dim data1 As String
Dim col1 As Long
Dim Idx As Long
Private Sub OptionButton1_Click()
TextBox39.Visible = True
TextBox33.Visible = True
TextBox40.Visible = False
TextBox34.Visible = False
TextBox41.Visible = False
TextBox35.Visible = False
TextBox42.Visible = False
TextBox36.Visible = False
TextBox43.Visible = False
TextBox37.Visible = False
TextBox44.Visible = False
TextBox38.Visible = False
OptionButton1.Visible = True
OptionButton2.Visible = False
OptionButton3.Visible = False
OptionButton4.Visible = False
OptionButton5.Visible = False
OptionButton6.Visible = False
End Sub
Private Sub OptionButton2_Click()
TextBox39.Visible = False
TextBox33.Visible = False
TextBox40.Visible = True
TextBox34.Visible = True
TextBox41.Visible = False
TextBox35.Visible = False
TextBox42.Visible = False
TextBox36.Visible = False
TextBox43.Visible = False
TextBox37.Visible = False
TextBox44.Visible = False
TextBox38.Visible = False
OptionButton1.Visible = False
OptionButton2.Visible = True
OptionButton3.Visible = False
OptionButton4.Visible = False
OptionButton5.Visible = False
OptionButton6.Visible = False
End Sub
Private Sub OptionButton3_Click()
TextBox39.Visible = False
TextBox33.Visible = False
TextBox40.Visible = False
TextBox34.Visible = False
TextBox41.Visible = True
TextBox35.Visible = True
TextBox42.Visible = False
TextBox36.Visible = False
TextBox43.Visible = False
TextBox37.Visible = False
TextBox44.Visible = False
TextBox38.Visible = False
OptionButton1.Visible = False
OptionButton2.Visible = False
OptionButton3.Visible = True
OptionButton4.Visible = False
OptionButton5.Visible = False
OptionButton6.Visible = False
End Sub
Private Sub OptionButton4_Click()
TextBox39.Visible = False
TextBox33.Visible = False
TextBox40.Visible = False
TextBox34.Visible = False
TextBox41.Visible = False
TextBox35.Visible = False
TextBox42.Visible = True
TextBox36.Visible = True
TextBox43.Visible = False
TextBox37.Visible = False
TextBox44.Visible = False
TextBox38.Visible = False
OptionButton1.Visible = False
OptionButton2.Visible = False
OptionButton3.Visible = False
OptionButton4.Visible = True
OptionButton5.Visible = False
OptionButton6.Visible = False
End Sub
Private Sub OptionButton5_Click()
TextBox39.Visible = False
TextBox33.Visible = False
TextBox40.Visible = False
TextBox34.Visible = False
TextBox41.Visible = False
TextBox35.Visible = False
TextBox42.Visible = False
TextBox36.Visible = False
TextBox43.Visible = True
TextBox37.Visible = True
TextBox44.Visible = False
TextBox38.Visible = False
OptionButton1.Visible = False
OptionButton2.Visible = False
OptionButton3.Visible = False
OptionButton4.Visible = False
OptionButton5.Visible = True
OptionButton6.Visible = False
End Sub
Private Sub OptionButton6_Click()
TextBox39.Visible = False
TextBox33.Visible = False
TextBox40.Visible = False
TextBox34.Visible = False
TextBox41.Visible = False
TextBox35.Visible = False
TextBox42.Visible = False
TextBox36.Visible = False
TextBox43.Visible = False
TextBox37.Visible = False
TextBox44.Visible = True
TextBox38.Visible = True
OptionButton1.Visible = False
OptionButton2.Visible = False
OptionButton3.Visible = False
OptionButton4.Visible = False
OptionButton5.Visible = False
OptionButton6.Visible = True
End Sub
'-------------------------------------------------------------------------------------
' Module : USF_MOD/Ajout_Click
' Bouton :modifier
'-------------------------------------------------------------------------------------
Private Sub Ajout_Intervention_Click()
If ligne1 = 0 Then Exit Sub
With Sheets("Feuil1")
For i = 1 To 38
.Cells(ligne1, i).Value = Me.Controls("Textbox" & i)
Next
End With
If ajout_contrat.OptionButton1 = -1 Then
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox33.Value, TextToDisplay:=TextBox39.Value
End If
If ajout_contrat.OptionButton2 = -1 Then
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox34.Value, TextToDisplay:=TextBox40.Value
End If
If ajout_contrat.OptionButton3 = -1 Then
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox35.Value, TextToDisplay:=TextBox41.Value
End If
If ajout_contrat.OptionButton4 = -1 Then
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox36.Value, TextToDisplay:=TextBox42.Value
End If
If ajout_contrat.OptionButton5 = -1 Then
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox37.Value, TextToDisplay:=TextBox43.Value
End If
If ajout_contrat.OptionButton6 = -1 Then
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox38.Value, TextToDisplay:=TextBox44.Value
End If
With ListView1
.ListItems.Item(Idx) = TextBox1
For i = 33 To 38
.ListItems(Idx).SubItems(i - 1) = Me.Controls("TextBox" & i)
Next
End With
For j = 1 To 38
Controls("TextBox" & j) = ""
Next
' For i = 1 To 6 'boucle sur les combobox pour vérif si toutes sont renseignées
' If ajout_contrat.Controls("OptionButton" & i) = "" Then
' ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox33.Value, TextToDisplay:=TextBox39.Value
' ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox34.Value, TextToDisplay:=TextBox40.Value
' ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox35.Value, TextToDisplay:=TextBox41.Value
' ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox36.Value, TextToDisplay:=TextBox42.Value
' ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox37.Value, TextToDisplay:=TextBox43.Value
' ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=TextBox38.Value, TextToDisplay:=TextBox44.Value
' Exit Sub
' End If
' Next
End Sub
Private Sub ComboBox1_Change()
If flag = True Then Exit Sub
flag = True
i = 1
With Me.Controls("ComboBox" & i)
coln = Chr(64 + CLng(.List(.ListIndex, .ColumnCount - 1)))
End With
With Me.Controls("ComboBox" & i + 10)
.Visible = True
Call IniCombobox1(nomfeuille1, coln, 5, i + 10, True)
End With
Label1.Visible = True
flag = False
End Sub
Private Sub ComboBox11_Change()
If flag = True Then Exit Sub
i = 1
With Me.Controls("ComboBox" & i)
If Me.Controls("ComboBox" & i + 10).Value <> "" Then
col1 = CLng(.List(.ListIndex, .ColumnCount - 1))
data1 = Me.Controls("ComboBox" & i + 10).Value
Else
col1 = 0
data1 = ""
End If
End With
affichecombo (True)
remplirafficher
ComboBox11.Visible = False
ComboBox1.Visible = False
Label1.Visible = False
Label10.Visible = False
End Sub
Private Sub Combobox22_Change()
ComboBox22.Visible = False
If flag = True Then Exit Sub
data1me = ComboBox22.Value
If data1me <> "" Then
With ListView1
'Boucle sur toutes les lignes
For i = .ListItems.Count To 1 Step -1
If .ListItems(i) <> data1me Then ListView1.ListItems.Remove i
Next i
End With
rempircomboaveclistview
End If
End Sub
'-------------------------------------------------------------------------------------
' Module : USF_MOD/Combobox23_Change
' Utilisation : on efface de la listview les données qui ne sont pas dans le choix
' on remet à jour les combobox
'-------------------------------------------------------------------------------------
Private Sub Combobox23_Change()
If flag = True Then Exit Sub
With ComboBox23
If .Value = "" Then Exit Sub
Call modiflistview(1, .Value)
End With
End Sub
Private Sub ComboBox24_Change()
If flag = True Then Exit Sub
With ComboBox24
If .Value = "" Then Exit Sub
Call modiflistview(2, .Value)
End With
End Sub
Private Sub ComboBox25_Change()
ComboBox25.Visible = False
End Sub
Private Sub ComboBox26_Change()
ComboBox26.Visible = False
End Sub
Private Sub ComboBox27_Change()
ComboBox27.Visible = False
End Sub
Private Sub ComboBox28_Change()
ComboBox28.Visible = False
End Sub
Private Sub ComboBox29_Change()
ComboBox29.Visible = False
End Sub
Private Sub ComboBox30_Change()
ComboBox30.Visible = False
End Sub
Private Sub ComboBox31_Change()
ComboBox31.Visible = False
End Sub
Private Sub ComboBox32_Change()
ComboBox32.Visible = False
End Sub
Private Sub Fermer_Click()
Unload Me
Worksheets("Menu").Activate
Worksheets("Menu").Visible = True
Menu.Show
End Sub
Private Sub BT_MOD_INI_Click()
col1 = 0 ' pas de colonne
UserForm_Initialize
Me.Controls("Listview" & 1).ListItems.Clear
End Sub
'-------------------------------------------------------------------------------------
' Module : usfAffichage/ListView1_ColumnClick
' Utilisation :trier les listes en cliquant sur une colonne en tenant compte des dates
' il faut reserver la dernière colonne
' on transforme les dates en valeur numériques
' comme le format des dates est modifiées il faut supprimer ce code
'-------------------------------------------------------------------------------------
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Call tierliste(1, ColumnHeader.Index - 1)
End Sub
'-------------------------------------------------------------------------------------
' Module : USF_MOD/ListView1_ItemClick
' Utilisation :remplir les textbox
'-------------------------------------------------------------------------------------
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
With ListView1
Idx = .SelectedItem.Index
ligne1 = 0
ligne1 = Mid(.ListItems(Item.Index).Key, 2, 50)
For i = 1 To 38
Select Case i
Case 1
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("A" & ligne1).Value
Case 2
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("B" & ligne1).Value
Case 3
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("C" & ligne1).Value
Case 4
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("D" & ligne1).Value
Case 5
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("E" & ligne1).Value
Case 6
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("F" & ligne1).Value
Case 7
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("G" & ligne1).Value
Case 8
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("H" & ligne1).Value
Case 9
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("I" & ligne1).Value
Case 10
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("J" & ligne1).Value
Case 11
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("K" & ligne1).Value
Case 12
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("L" & ligne1).Value
Case 13
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("M" & ligne1).Value
Case 14
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("N" & ligne1).Value
Case 15
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("O" & ligne1).Value
Case 16
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("P" & ligne1).Value
Case 17
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("Q" & ligne1).Value
Case 18
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("R" & ligne1).Value
Case 19
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("S" & ligne1).Value
Case 20
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("T" & ligne1).Value
Case 21
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("U" & ligne1).Value
Case 22
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("V" & ligne1).Value
Case 23
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("W" & ligne1).Value
Case 24
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("X" & ligne1).Value
Case 25
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("Y" & ligne1).Value
Case 26
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("Z" & ligne1).Value
Case 27
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AA" & ligne1).Value
Case 28
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AB" & ligne1).Value
Case 29
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AC" & ligne1).Value
Case 30
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AD" & ligne1).Value
Case 31
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AE" & ligne1).Value
Case 32
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AF" & ligne1).Value
Case 33
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AG" & ligne1).Value
Case 34
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AH" & ligne1).Value
Case 35
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AI" & ligne1).Value
Case 36
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AJ" & ligne1).Value
Case 37
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AK" & ligne1).Value
Case 38
Me.Controls("Textbox" & i) = Sheets("Feuil1").Range("AL" & ligne1).Value
Case Is > 1
Me.Controls("Textbox" & i) = .ListItems(Item.Index).ListSubItems(i - 1).Text
End Select
Next i
End With
End Sub
Private Sub UserForm_Initialize()
nomfeuille1 = "Feuil1"
lignetitre = 1 ' ligne des titres
coldepart = 1
col1 = 0
data1 = ""
comboligne (1)
affichecombo (False)
End Sub
'****************************************
' ne pas modifier les macros suivantes
'****************************************
'-------------------------------------------------------------------------------------
' Module : usfAffichage/Affiche
' Utilisation : remplir une listview
'-------------------------------------------------------------------------------------
Private Sub Affiche(£nu As Integer, £nomfeu As String, £premcol As String, £donne As Variant)
Dim £derlig As Long
Dim £i As Long
Dim £j As Integer
Dim Cel As Range
Dim £trouve As Byte
Dim firstAddress As String
Dim £ligne As Long
Me.Controls("Listview" & £nu).ListItems.Clear
If col1 = 0 Or data1 = "" Then ' pas de sélection
' Boucle de la ligne 2 à la dernière
With Me.Controls("Listview" & £nu)
£derlig = Sheets(£nomfeu).Cells.SpecialCells(xlCellTypeLastCell).Row
' Initialisation de la ligne dans le listview
For £i = 1 To £derlig
.ListItems.Add , "K" & £i, Sheets(£nomfeu).Range(£premcol & £i).Value
If UBound(£donne) > LBound(£donne) Then
For £j = LBound(£donne) To UBound(£donne)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets(£nomfeu).Range(CStr(£donne(£j)) & £i).Value
Next £j
End If
Next £i
End With
Else ' sélection
Dim dl1 As Long ' dernière ligne
With Sheets(£nomfeu).Range(Chr(col1 + 64) & 1 & ":" & Chr(col1 + 64) & Sheets(£nomfeu).Range(Chr(col1 + 64) & "65536").End(xlUp).Row)
If IsDate(data1) Then
Set Cel = .Find(CDate(data1), LookIn:=xlFormulas, SearchOrder:=xlByColumns, LookAt:=xlWhole)
Else
Set Cel = .Find(data1, LookIn:=xlValues, SearchOrder:=xlByColumns, LookAt:=xlWhole)
End If
If Not Cel Is Nothing Then
firstAddress = Cel.Address
Do
£trouve = 1
If £trouve = 1 And £ligne <> Cel.Row Then
' on rempli la listview
Me.Controls("Listview" & £nu).ListItems.Add , "K" & Cel.Row, Sheets(£nomfeu).Range(£premcol & Cel.Row).Value
£ligne = Cel.Row ' pour eviter les erreurs
If UBound(£donne) > LBound(£donne) Then
For £j = LBound(£donne) To UBound(£donne)
Me.Controls("Listview" & £nu).ListItems(Me.Controls("Listview" & £nu).ListItems.Count).ListSubItems.Add , , Sheets(£nomfeu).Range(CStr(£donne(£j)) & Cel.Row).Value
Next £j
End If
End If
Set Cel = .FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> firstAddress
End If
End With
End If
'Spécifie l'affichage en mode "Détails"
With Me.Controls("Listview" & £nu)
.Gridlines = True 'affichage d'un quadrillage
.FullRowSelect = True 'Sélection des lignes comlètes
.LabelEdit = 1
.MultiSelect = True 'Pour autoriser la multi sélection, vous devez tout d'abord passer la propriété Multiselect à True. Ensuite sélectionnez les lignes en gardant enfoncée la touche Ctrl.
.View = 3 'lvwReport affichage en mode Rapport
.Gridlines = True 'affichage d'un quadrillage
.FullRowSelect = True 'Sélection des lignes complètes
.HideColumnHeaders = False 'affichage des colonnes
.LabelEdit = 1 'empêcher la modification manuelle des données en spécifiant la valeur 1
.ListItems(1).Selected = False ' on désélectionne la première ligne
.MultiSelect = True 'Pour autoriser la multi sélection, vous devez tout d'abord passer la propriété Multiselect à True. Ensuite sélectionnez les lignes en gardant enfoncée la touche Ctrl.
Set .SelectedItem = Nothing
End With
End Sub
'-------------------------------------------------------------------------------------
' Module : usfAffichage/entete
' Utilisation : créer une listeview
'-------------------------------------------------------------------------------------
Private Sub entete(£nu As Integer, £donne As Variant)
Dim £i As Integer
With Me.Controls("Listview" & £nu)
With .ColumnHeaders
.Clear 'Supprime les anciens entêtes
For £i = LBound(£donne) To UBound(£donne) Step 2
.Add , , CStr(£donne(£i)), CLng(£donne(£i + 1))
Next £i
End With
End With
End Sub
'-------------------------------------------------------------------------------------
' Module : usfAffichage/tierliste
' Utilisation :trier
'call tierliste ( numéro de la listeview,ColumnHeader.Index - 1)
'-------------------------------------------------------------------------------------
Private Sub tierliste(£nulistview As Integer, £colonne As Integer)
With Me.Controls("Listview" & £nulistview)
.Sorted = False
.SortKey = £colonne
If .SortOrder = lvwAscending Then
.SortOrder = lvwDescending
Else
.SortOrder = lvwAscending
End If
.Sorted = True
End With
End Sub
'****************************************************
' macro à modifier en fonction des combobx
'-------------------------------------------------------------------------------------
' Module : USF_MOD/rempircomboaveclistview
'-------------------------------------------------------------------------------------
Private Sub rempircomboaveclistview()
Dim £i As Integer
Dim £j As Integer
flag = True ' pour éviter de lancer des procédures
For £i = 22 To 32
Me.Controls("ComboBox" & £i).Style = fmStyleDropDownCombo
Me.Controls("ComboBox" & £i).Clear
Next £i
' on remplit les combo en fonction du contenue de la listview
'Boucle sur toutes les lignes
For £i = 1 To ListView1.ListItems.Count
With Me.ComboBox22
If .ListCount > 0 Then .Value = ListView1.ListItems(£i).Text
If .ListIndex = -1 Then .AddItem ListView1.ListItems(£i).Text
End With
For £j = 23 To 32
Select Case £j
Case 25
' modification de format
data1me = ListView1.ListItems(£i).ListSubItems(£j - 22).Text
If IsDate(data1me) Then data1me = Format(CDate(data1me), "mm/yyyy")
With Me.ComboBox25
If .ListCount > 0 Then .Value = data1me
If .ListIndex = -1 Then .AddItem data1me
End With
Case Else
data1me = ListView1.ListItems(£i).ListSubItems(£j - 22).Text
With Me.Controls("ComboBox" & £j)
If .ListCount > 0 Then .Value = data1me
If .ListIndex = -1 Then .AddItem data1me
End With
End Select
Next £j
Next £i
' on modifie le stype pour éviter que l'utilsateur écrive des valeurs
For £i = 22 To 32
Me.Controls("ComboBox" & £i).Style = fmStyleDropDownList
Me.Controls("ComboBox" & £i).Value = ""
Next £i
flag = False ' on active les procédures
End Sub
Private Sub modiflistview(£nucolonne As Integer, £data1 As String)
Dim £i As Long
With ListView1
'Boucle sur toutes les lignes
For £i = .ListItems.Count To 1 Step -1
If .ListItems(£i).ListSubItems(£nucolonne).Text <> £data1 Then ListView1.ListItems.Remove £i
Next £i
End With
rempircomboaveclistview
End Sub
'-------------------------------------------------------------------------------------
' Module : USF_MOD/formatlistview
' Utilisation :Modifier les valeurs affichées dans la listview
'-------------------------------------------------------------------------------------
Private Sub formatlistview()
Dim £i As Long
For £i = 1 To ListView1.ListItems.Count
With ListView1.ListItems(£i).ListSubItems(8)
If IsDate(.Text) Then .Text = Format((CDate(.Text)), "dd/mm/yyyy")
End With
Next £i
End Sub
'-------------------------------------------------------------------------------------
' Module : UserForm41/IniCombobox1
' Utilisation :
'-------------------------------------------------------------------------------------
Private Sub IniCombobox1(£nomfeuil As String, £col As String, £lig As Long, £num As Integer, £tri As Boolean)
Dim plg As Range, Col As New Collection, Item As Variant
Dim £i1 As Long
Dim £i As Long
Dim £j As Integer
Dim £tablo()
Dim cellule As Range
Dim £trouve As Boolean
flag = True
With Sheets(£nomfeuil)
£i1 = .Range(£col & "65535").End(xlUp).Row 'On part de la dernière ligne de la feuille et on remonte
Set plg = .Range(£col & £lig & ":" & £col & £i1) 'On récupère les données
For Each cellule In plg ' pour chaque cellule de la plage
On Error Resume Next
Col.Add cellule.Value, CStr(cellule.Value)
Next cellule
End With
On Error GoTo 0
ReDim £tablo(1 To Col.Count)
£i1 = 1
For Each Item In Col
£tablo(£i1) = Item
£i1 = £i1 + 1
Next Item
Me.Controls("combobox" & £num).Clear
If £tri = True Then Call Tri(£tablo(), 1, UBound(£tablo, 1))
Me.Controls("combobox" & £num).List = £tablo
flag = False
End Sub
'-------------------------------------------------------------------------------------
' Module : tri
'Il s'agit d'une méthode de tri récursive dont l'efficacité est
'une fonction croissante du désordre dans le tableau à trier,
'c’est à dire que plus le tableau est désordonné,
'plus cette méthode de tri est efficace.
' Utilisation :trier les données dans le tableau dynamique ()
'-------------------------------------------------------------------------------------
Sub Tri(£a(), £gauc, £droi) ' Quick sort
Dim £ref As Variant, £g As Long, £d As Long
Dim £temp As Variant
£ref = £a(Int((£gauc + £droi) \ 2))
£g = £gauc: £d = £droi
Do
Do While £a(£g) < £ref: £g = £g + 1: Loop
Do While £ref < £a(£d): £d = £d - 1: Loop
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 Tri(£a, £g, £droi)
If £gauc < £d Then Call Tri(£a, £gauc, £d)
End Sub
Private Sub comboligne(£num As Integer)
flag = True
With Me.Controls("ComboBox" & £num)
.ColumnCount = 2 ' 2 colonnes listindex n'a pas de signification
.Visible = True
.ColumnWidths = "100;0" ' une colonne cachée
' dernière colonne
dc1 = Sheets(nomfeuille1).Range("IV" & lignetitre).End(xlToLeft).Column
'pour chaque colonne
For i = coldepart To dc1
' on ajoute le nom d'une colonne si la colonne n'a pas été utilisé
.AddItem Sheets(nomfeuille1).Cells(lignetitre, i)
.List(.ListCount - 1, .ColumnCount - 1) = i
Next i
End With
flag = False
End Sub
Private Sub remplirafficher()
'Si on désire trier des dates il faut créer une colonne supplémentaire en drenière position
Call entete(1, Array("a", 0, "b", 0, "c", 0, "d", 0, "e", 0, "f", 0, "g", 0, "h", 0, "i", 0, "j", 0, "k", 0, "l", 0, "m", 0, "n", 0, "o", 0, "p", 0, "q", 0, "r", 0, "s", 0, "t", 0, "u", 0, "v", 0, "w", 0, "x", 0, "y", 0, "z", 0, "aa", 0, "ab", 0, "ac", 0, "ad", 0, "ae", 0, "af", 0, "Numéro 1", 70, "Numéro 2", 70, "Numéro 3", 70, "Numéro 4", 70, "Numéro 5", 70, "Numéro 6", 70))
'Call Affiche(numéro de la listview, nom de la feuille , première colonne , Array(deuxième colone , "d", "e", "f", "g", "h", "i"))
Call Affiche(1, "Feuil1", "a", Array("b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "aa", "ab", "ac", "ad", "ae", "af", "ag", "ah", "ai", "aj", "ak", "al"))
' remplir les combobox avec le contenu de la listview
formatlistview
rempircomboaveclistview
End Sub
Private Sub affichecombo(val1 As Boolean)
For i = 22 To 32
Me.Controls("label" & i).Visible = val1
Me.Controls("ComboBox" & i).Visible = val1
Next i
Frame1.Visible = val1
End Sub