Multiselect et textbox

V

vassili

XLDnaute Occasionnel
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

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
 

Discussions similaires

C
  • Résolu(e)
XL 2021 Alimenter Listbox si colonne 3 contient un mot précis
Réponses
5
Affichages
213
Claudinedu13
C
T
  • Question
Microsoft 365 Problème affichage multipage dans un tabstrip
Réponses
1
Affichages
333
troki74
T
M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
404
Mody200
M
A
  • Résolu(e)
XL 2013 Calcule de produit dans un textbox
Réponses
6
Affichages
209
Appo1985
A
A
  • Résolu(e)
XL 2013 Calcule de produit dans un textbox
Réponses
3
Affichages
166
job75
job75
C
  • Résolu(e)
XL 2021 exclure certaines lignes d'un combobox
Réponses
4
Affichages
225
Claudinedu13
C
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Efface automatiquement le contenu d'une cellule en fonction d'une autre cellule
Réponses
9
Affichages
281
chaelie2015
chaelie2015
S
  • Question
XL 2013 recherche intuitif semi automatique dans Combobox (trié et avec valeur unique) inseré en UserForm VBA
2
Réponses
18
Affichages
407
Sghaier Chafaa
S
Messan
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
370
Messan
Messan
L
  • Question
XL 2021 Comment utiliser la colonne d'une adresse en Private Sub - svp ?
Réponses
3
Affichages
254
vgendron
vgendron

Membres actuellement en ligne

12 membres et 87 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 107
Messages
2 085 358
Membres
102 874
dernier inscrit
Petro2611