eurreur dans un code de filtration

geraldvc

XLDnaute Junior
bonjour, voici un code ou d'une part je peut filtrer et d'autre part ou je peut modifier
le tout viens d'une base de donnée feuille"data" la base nomée listedata

je ne parviens plus a la filtrer les combo cbx1 à cbx26 exemple cbx1 correspond a la col 4, cbx2 col 2, cbx3 col 6 cbx4 col 1, ext... jusque la col 108

voila si vous voulez je peu vous envoyer par mail car je n'arrive pas a descendre en dessous des 80k compressé!!

geraldvc@gmail.com

Private Sub Cbx1_Click()
ListView1.ListItems.Clear
Alim_Listv 4, 4
'Vide_Combo 1
End Sub

Private Sub Cbx2_Click()
ListView1.ListItems.Clear
Alim_Listv 2, 2
'Vide_Combo 2+
End Sub

Private Sub Cbx3_Click()
ListView1.ListItems.Clear
Alim_Listv 6, 6
'Vide_Combo 3
End Sub

Private Sub Cbx4_Click()
ListView1.ListItems.Clear
Alim_Listv 1, 1
'Vide_Combo 4
End Sub

Private Sub Cbx5_Click()
ListView1.ListItems.Clear
Alim_Listv 64, 64
'Vide_Combo 5
End Sub

Private Sub Cbx6_Click()
ListView1.ListItems.Clear
Alim_Listv 94, 94
'Vide_Combo 6
End Sub






Private Sub cbx7_Click()
ListView1.ListItems.Clear
Alim_Listv 9, 9
End Sub
Private Sub cbx8_Click()
ListView1.ListItems.Clear
Alim_Listv 12, 12
End Sub

Private Sub cbx9_Click()
ListView1.ListItems.Clear
Alim_Listv 14, 14
End Sub
Private Sub cbx10_Click()
ListView1.ListItems.Clear
Alim_Listv 15, 15
End Sub
Private Sub cbx11_Click()
ListView1.ListItems.Clear
Alim_Listv 13, 13
End Sub
Private Sub cbx12_Click()
ListView1.ListItems.Clear
Alim_Listv 93, 93
End Sub
Private Sub cbx13_Click()
ListView1.ListItems.Clear
Alim_Listv 95, 95
End Sub
Private Sub cbx14_Click()
ListView1.ListItems.Clear
Alim_Listv 96, 96
End Sub

Private Sub cbx15_Click()
ListView1.ListItems.Clear
Alim_Listv 97, 97
End Sub

Private Sub cbx16_Click()
ListView1.ListItems.Clear
Alim_Listv 98, 98
End Sub


Private Sub cbx17_Click()
ListView1.ListItems.Clear
Alim_Listv 99, 99
End Sub
Private Sub cbx18_Click()
ListView1.ListItems.Clear
Alim_Listv 100, 100
End Sub
Private Sub cbx19_Click()
ListView1.ListItems.Clear
Alim_Listv 101, 101
End Sub

Private Sub cbx20_Click()
ListView1.ListItems.Clear
Alim_Listv 102, 102
End Sub


Private Sub cbx21_Click()
ListView1.ListItems.Clear
Alim_Listv 103, 103
End Sub
Private Sub cbx22_Click()
ListView1.ListItems.Clear
Alim_Listv 104, 104
End Sub
Private Sub cbx23_Click()
ListView1.ListItems.Clear
Alim_Listv 105, 105
End Sub

Private Sub cbx24_Click()
ListView1.ListItems.Clear
Alim_Listv 106, 106
End Sub
Private Sub cbx25_Click()
ListView1.ListItems.Clear
Alim_Listv 107, 107
End Sub

Private Sub cbx26_Click()
ListView1.ListItems.Clear
Alim_Listv 108, 108
End Sub










Private Sub CommandButton1_Click()
Unload Me
End Sub














Private Sub CommandButton2_Click() 'modification

Dim k As Byte, ItemSelect As Long, x As Byte, Numlign As Long

With ListView1
ItemSelect = .SelectedItem.Index 'N° de l'index sélectionné dans la lisview
Numlign = center(.ListItems(.SelectedItem.Index).Key, Len(.ListItems(.SelectedItem.Index).Key) - 1) 'N° ligne de la feuille
If MsgBox("Confirmation de la modification.", vbYesNo, "Confirmation") = vbYes Then
'mise à jour des colonnes de la listview
.ListItems(ItemSelect).Text = UCase(TextBox1)
For k = 1 To 24
If k <> 2 Then .ListItems(ItemSelect).ListSubItems(k).Text = Controls("TextBox" & k + 1)
Next
'.ListItems(ItemSelect).ListSubItems(2).Text = CDate(TextBox3)
'mise à jour de la feuille
Sheets("Data").Cells(Numlign, 1) = UCase(.ListItems(ItemSelect).Text)
Sheets("Data").Cells(Numlign, 2) = UCase(.ListItems(ItemSelect).ListSubItems(1).Text)

For k = 3 To 50
Sheets("Data").Cells(Numlign, k + 1) = UCase(.ListItems(ItemSelect).ListSubItems(k).Text)
Next
Sheets("Data").Cells(Numlign, 7) = UCase(.ListItems(ItemSelect).ListSubItems(6).Text)
Sheets("Data").Cells(Numlign, 8) = UCase(.ListItems(ItemSelect).ListSubItems(7).Text)
Sheets("Data").Cells(Numlign, 9) = UCase(.ListItems(ItemSelect).ListSubItems(8).Text)
Sheets("Data").Cells(Numlign, 10) = UCase(.ListItems(ItemSelect).ListSubItems(9).Text)
Sheets("Data").Cells(Numlign, 11) = UCase(.ListItems(ItemSelect).ListSubItems(10).Text)
Sheets("Data").Cells(Numlign, 12) = UCase(.ListItems(ItemSelect).ListSubItems(11).Text)
Sheets("Data").Cells(Numlign, 13) = UCase(.ListItems(ItemSelect).ListSubItems(12).Text)
Sheets("Data").Cells(Numlign, 14) = UCase(.ListItems(ItemSelect).ListSubItems(13).Text)
Sheets("Data").Cells(Numlign, 15) = UCase(.ListItems(ItemSelect).ListSubItems(14).Text)
Sheets("Data").Cells(Numlign, 16) = UCase(.ListItems(ItemSelect).ListSubItems(15).Text)
Sheets("Data").Cells(Numlign, 17) = UCase(.ListItems(ItemSelect).ListSubItems(16).Text)
Sheets("Data").Cells(Numlign, 18) = UCase(.ListItems(ItemSelect).ListSubItems(17).Text)
Sheets("Data").Cells(Numlign, 19) = UCase(.ListItems(ItemSelect).ListSubItems(18).Text)
Sheets("Data").Cells(Numlign, 20) = UCase(.ListItems(ItemSelect).ListSubItems(19).Text)
Sheets("Data").Cells(Numlign, 21) = UCase(.ListItems(ItemSelect).ListSubItems(20).Text)
Sheets("Data").Cells(Numlign, 22) = UCase(.ListItems(ItemSelect).ListSubItems(21).Text)
Sheets("Data").Cells(Numlign, 23) = UCase(.ListItems(ItemSelect).ListSubItems(22).Text)



MiseEnForme
.ListItems(ItemSelect).Selected = False
For x = 1 To 24
Controls("TextBox" & x) = ""
Next
CommandButton2.Enabled = False
Alim_Combo
Vide_Combo
Exit Sub
Else
.ListItems(ItemSelect).Selected = False
For x = 1 To 24
Controls("TextBox" & x) = ""
Next
CommandButton2.Enabled = False
Exit Sub
End If
End With

End Sub

Private Sub CommandButton3_Click() 'reinisalisation des combo cbx

Dim k As Byte
ListView1.ListItems.Clear
For k = 1 To 26
Controls("Cbx" & k) = ""
Next
UserForm_Initialize

End Sub

Private Sub CommandButton4_Click()
Dim Derlign As Long, k As Byte, Col As Byte 'La première ligne de la macro du bouton concerne la déclaration des variables :

Derlign = Sheets("Data").Range("D65536").End(xlUp).Row + 1 'étermines la 1ère ligne vide et tu affectes la valeur 1 (n° de la colonne a) à la variable "Col" comme ceci :
Col = 95

With Sheets("Data") ' determine les combo a envoyer dans la feuillr data
.Range("e" & Derlign) = cbxa5
.Range("a" & Derlign) = cbxa1
.Range("d" & Derlign) = cbxa4
.Range("b" & Derlign) = cbxa2
.Range("c" & Derlign) = cbxa3
.Range("f" & Derlign) = cbxa6
.Range("bl" & Derlign) = cbxa64
.Range("cp" & Derlign) = cbxa94
.Range("i" & Derlign) = cbxa9
.Range("l" & Derlign) = cbxa12
.Range("n" & Derlign) = cbxa14
.Range("o" & Derlign) = cbxa15
.Range("m" & Derlign) = cbxa13
.Range("bf" & Derlign) = cbxa58
.Range("ax" & Derlign) = cbxa49
.Range("cb" & Derlign) = Cbxa80
.Range("af" & Derlign) = cbxa32
.Range("al" & Derlign) = cbxa38
.Range("ai" & Derlign) = cbxa35
.Range("ae" & Derlign) = cbxa31
.Range("co" & Derlign) = cbxa93
.Range("bz" & Derlign) = cbxa78

End With
With ListView2
For k = 1 To .ListItems.Count
Sheets("Data").Cells(Derlign, Col) = .ListItems(k).Text
Sheets("Data").Cells(Derlign, Col + 1) = .ListItems(k).ListSubItems(1).Text
Col = Col + 2
Next
.ListItems.Clear

cbxa1.Value = ""
cbxa2.Value = ""
cbxa3.Value = ""
cbxa4.Value = ""
cbxa5.Value = ""
cbxa6.Value = ""

cbxa64.Value = ""
cbxa94.Value = ""
cbxa12.Value = ""
cbxa14.Value = ""
cbxa15.Value = ""
cbxa13.Value = ""

cbxa58.Value = ""
cbxa49.Value = ""
Cbxa80.Value = ""
cbxa32.Value = ""
cbxa38.Value = ""
cbxa35.Value = ""

cbxa31.Value = ""
cbxa93.Value = ""
cbxa78.Value = ""

End With
End Sub






Private Sub CommandButton5_Click()
Unload Me
End Sub



Private Sub CommandButton6_Click()
Me.ListBox3 = Me.TextBox1

'Me.MultiPage3.Selected


End Sub

Private Sub CommandButton7_Click()

Dim y As Long, Collec

With ListView2
With .ColumnHeaders
.Add , , "Continent", "140"
.Add , , "Pays", "90"
End With
.View = lvwReport
.FullRowSelect = True
.Gridlines = True
End With


If cbxa140.ListIndex = -1 Then
MsgBox "Sélectionné un continent", vbInformation, "Continent"
Exit Sub
End If

If cbxa100.ListIndex = -1 Then
MsgBox "Sélectionné un pays", vbInformation, "Pays"
Exit Sub
End If

With ListView2
.ListItems.Add , , cbxa140.Value
.ListItems(.ListItems.Count).ListSubItems.Add , , cbxa100.Value
End With

cbxa140.ListIndex = -1
cbxa100.ListIndex = -1






End Sub

Private Sub Frame3_Click()

End Sub

Private Sub Image1_Click()

End Sub

Private Sub ListView1_DblClick() 'modification

Dim x As Byte, Numlign As Long

'--Code sans MsgBox
''With ListView1
'' .SelectedItem.ListSubItems(2).Text = IIf(.SelectedItem.ListSubItems(2) = "", "X", "")
'' Sheets("Feuil1").Range("C" & .SelectedItem.Index + 1) = .SelectedItem.ListSubItems(2).Text
'' MiseEnForme
''.ListItems(.SelectedItem.Index).Selected = False
''End With

'=========
'Code avec MsgBox la grandeur et le nbr de colonne dans la listview
With ListView1
Numlign = center(.ListItems(.SelectedItem.Index).Key, Len(.ListItems(.SelectedItem.Index).Key) - 1)
If .ListItems(.SelectedItem.Index).Text = "NP" Then
If MsgBox("Confirmer le Pointage.", vbYesNo, "Pointage") = vbYes Then
.ListItems(.SelectedItem.Index).Text = "P"
Sheets("Data").Range("A" & Numlign) = .ListItems(.SelectedItem.Index).Text
MiseEnForme
.ListItems(.SelectedItem.Index).Selected = False
For x = 1 To 24
Controls("TextBox" & x) = ""
Next
CommandButton2.Enabled = False
Exit Sub
'======
Else
.ListItems(.SelectedItem.Index).Selected = False
For x = 1 To 24
Controls("TextBox" & x) = ""
Next
CommandButton2.Enabled = False
End If
End If

If .ListItems(.SelectedItem.Index).Text = "P" Then
If MsgBox("Confirmer la suppression du Pointage.", vbYesNo, "Suppression du Pointage") = vbYes Then
.ListItems(.SelectedItem.Index).Text = "NP"
Sheets("Data").Range("A" & Numlign) = .ListItems(.SelectedItem.Index).Text
MiseEnForme
.ListItems(.SelectedItem.Index).Selected = False
For x = 1 To 24
Controls("TextBox" & x) = ""
Next
CommandButton2.Enabled = False
Exit Sub
Else
.ListItems(.SelectedItem.Index).Selected = False
For x = 1 To 24
Controls("TextBox" & x) = ""
Next
CommandButton2.Enabled = False
End If
End If
End With

End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
MiseAJourTB
CommandButton2.Enabled = True
End Sub



Private Sub UserForm_Activate()
Set f = Sheets("pays")
Set mondico = CreateObject("Scripting.Dictionary")
For Each C In f.Range("A2", f.[A65000].End(xlUp))
If Not mondico.Exists(C.Value) Then mondico.Add C.Value, C.Value
Next C
Me.cbxa140.List = mondico.items
Me.cbxa140.ListIndex = 0
Me.cbxa140.AddItem "****************"
For Each i In mondico.items
Me.cbxa140.AddItem i
Next
Me.cbxa140.ListIndex = 0


Cbx1.RowSource = "'data'!d2:d65000"
Cbx2.RowSource = "'data'!b2:b65000"
Cbx3.RowSource = "'data'!f2:f65000"
Cbx4.RowSource = "'data'!a2:a65000"
Cbx5.RowSource = "'data'!bl2:bl65000"
Cbx6.RowSource = "'data'!cp2:cp65000"
Cbx7.RowSource = "'data'!i2:i65000"
Cbx8.RowSource = "'data'!l2:l65000"
Cbx9.RowSource = "'data'!n2:n65000"
Cbx10.RowSource = "'data'!o2:eek:65000"
Cbx11.RowSource = "'data'!m2:m65000"
Cbx12.RowSource = "'data'!co2:co65000"

Cbx13.RowSource = "'data'!cq2:cq65000"
Cbx14.RowSource = "'data'!cr2:cr65000"
Cbx15.RowSource = "'data'!cs2:cs65000"
Cbx16.RowSource = "'data'!ct2:ct65000"
Cbx17.RowSource = "'data'!cu2:cu65000"
Cbx18.RowSource = "'data'!cv2:cv65000"
Cbx19.RowSource = "'data'!cw2:cw65000"
Cbx20.RowSource = "'data'!cx2:cx65000"
Cbx21.RowSource = "'data'!cy2:cy65000"
Cbx22.RowSource = "'data'!cz2:cz65000"
Cbx23.RowSource = "'data'!da2:da65000"
Cbx24.RowSource = "'data'!db2:db65000"
Cbx25.RowSource = "'data'!dc2:dc65000"
Cbx26.RowSource = "'data'!dd2:dd65000"

End Sub

Private Sub cbxa140_Change()
Set f = Sheets("pays")
Me.cbxa100.Clear
For Each C In f.Range("A2", f.[A65000].End(xlUp))
If C = Me.cbxa140 Or Me.cbxa140 = "choix pays" Then


Me.cbxa100.AddItem C.Offset(0, 1) ' determine la colonne du choix continent
End If
Next C
'Me.cbxa100.ListIndex = 0
End Sub

Private Sub UserForm_Initialize()
'--Affiche quadrillage dans la ListView

Dim i As Long, x As Long, k As Byte, total As Variant

With ListView1 'vue des filtration
'Entête
With .ColumnHeaders
.Clear
.Add , , "nom", 50 'titre de la colonne et largeur et alignement
.Add , , "sociéte", 90
.Add , , "categorie", 90, lvwColumnCenter
.Add , , "Membre", 80
.Add , , "Ville", 70
.Add , , "code postale", 90, lvwColumnRight
.Add , , "rue", 90, lvwColumnRight
.Add , , "Pays domicile", 60
.Add , , "cree le", 60, lvwColumnRight
.Add , , "region", 60, lvwColumnRight


.Add , , "tel bureau", 90, lvwColumnRight
.Add , , "tel domicile", 90, lvwColumnRight
.Add , , "fax", 90, lvwColumnRight
.Add , , "gsm", 90, lvwColumnRight
.Add , , "pag web", 90, lvwColumnRight
.Add , , "email", 90, lvwColumnRight
.Add , , "prenom", 60, lvwColumnRight
.Add , , "deuximeprenom", 90, lvwColumnRight
.Add , , "anniversaire", 90, lvwColumnRight
.Add , , "titre", 90, lvwColumnRight
.Add , , "suffix", 90, lvwColumnRight
.Add , , "commantaire", 90, lvwColumnRight

.Add , , "continent1", 90, lvwColumnRight
.Add , , "pays visité1", 90, lvwColumnRight

.Add , , "continent2", 90, lvwColumnRight
.Add , , "pays visité2", 90, lvwColumnRight

.Add , , "continent3", 90, lvwColumnRight
.Add , , "pays visité3", 90, lvwColumnRight

.Add , , "continent4", 90, lvwColumnRight
.Add , , "pays visité4", 90, lvwColumnRight

.Add , , "continent5", 90, lvwColumnRight
.Add , , "pays visité5", 90, lvwColumnRight

.Add , , "continent6", 90, lvwColumnRight
.Add , , "pays visité6", 90, lvwColumnRight

.Add , , "continent7", 90, lvwColumnRight
.Add , , "pays visité7", 90, lvwColumnRight


End With

.View = lvwReport
.FullRowSelect = True
.Gridlines = True
' Chargement des données dans les colone de la listeview (i,6) corespon la colonne dans la feuilles
'Me.Somme = 0
'Me.Label18 = 0
Sheets("Data").Range("A1").AutoFilter

For i = 2 To Sheets("Data").Range("B65536").End(xlUp).Row

.ListItems.Add , "M" & i, Sheets("Data").Cells(i, 4) 'nom
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 6) 'societe
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 64) 'Categorie

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 94) 'Membre
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 12) 'ville
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 14) 'code postal
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 9) 'rue
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 15) 'pays

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 93) 'crée le
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 13) 'region

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 32) 'tel bureau
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 38) 'tel domicile
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 31) 'fax
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 35) 'gsm
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 80) 'page web
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 49) 'email
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 2) 'prenom
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 3) 'deuxieme prenom
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 58) 'anniversaire
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 1) 'titre
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 5) 'sufix
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 78) 'commentaire

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 96) 'continent1
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 95) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 98) 'continent2
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 97) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 100) 'continent3
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 99) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 101) 'continent4
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 102) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 104) 'continent
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 103) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 106) 'continent
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 105) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 108) 'continent
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 107) 'pays visiité


'
Next
' Nom des Labels automatique et le nombre de label pour les textbox
For k = 1 To 22
Controls("Label" & k).Caption = ListView1.ColumnHeaders(k)
Next
.ListItems(1).Selected = False
End With
Alim_Combo
'

CommandButton2.Enabled = False

Dim y As Long, Collec

With ListView3
With .ColumnHeaders
.Add , , "Continent", "140"
.Add , , "Pays", "90"
End With
.View = lvwReport
.FullRowSelect = False
.Gridlines = True
End With




End Sub

Private Sub MiseEnForme()

Dim x As Long
With ListView1
For x = 1 To .ListItems.Count
If .ListItems(x) = UCase("P") Then
.ListItems(x).ForeColor = &HFF0000
For J = 1 To 27
.ListItems(x).ListSubItems(J).ForeColor = &HFF0000
Next
Else
.ListItems(x).ForeColor = &H0&
For J = 1 To 26
.ListItems(x).ListSubItems(J).ForeColor = &H0&
Next
End If
Next
End With

End Sub

Private Sub MiseAJourTB()
' inscripction dans les textebox et nombre des textebox -1!!!! 1 to 21 = 22 textebox
Dim k As Byte
TextBox1 = ListView1.ListItems(ListView1.SelectedItem.Index).Text
For k = 1 To 21
Controls("TextBox" & k + 1) = ListView1.ListItems(ListView1.SelectedItem.Index).ListSubItems(k)
Next

End Sub

Private Sub Alim_Combo() ' filtrage il y a 26 combo qui son nomee cbx 1 a 26

Dim Cell As Range, i As Long, J As Long, k As Byte
Dim Tablo(), Temp
Dim Sptd As Object

For k = 0 To 25
Set Sptd = CreateObject("Scripting.Dictionary")
With Sheets("Data")
For Each C In .Range("A2", [A65536].End(xlUp)).SpecialCells(xlCellTypeVisible)
If Not Sptd.Exists(C.Offset(0, k).Value) Then
Sptd.Add C.Offset(0, k).Value, C.Offset(0, k).Value
End If
Next C

Tablo = Sptd.items
For i = LBound(Tablo) To UBound(Tablo)
For J = LBound(Tablo) To UBound(Tablo)
If Tablo(i) < Tablo(J) Then
Temp = Tablo(i)
Tablo(i) = Tablo(J)
Tablo(J) = Temp
End If
Next J
Next i

Controls("Cbx" & k + 1).List = Tablo
Set Sptd = Nothing
Erase Tablo
End With

Next k


End Sub

Private Sub Alim_Listv(J As Byte, Col As Byte) 'filtrage

Dim i As Long, k As Byte, Dt As Date

With Sheets("Data")
'Me.Somme = 0
'Me.Label18 = 0

.Range("A2").AutoFilter

For i = 1 To 26
If Controls("Cbx" & i).Value <> vbNullString Then
If i = 40 Then
Dt = Controls("Cbx" & i).Value
.Range("A2").AutoFilter Field:=i, Criteria1:=DateSerial(Year(Dt), Month(Dt), Day(Dt))
Else
.Range("A2").AutoFilter Field:=i, Criteria1:=Controls("Cbx" & i).Value
End If
Else
.Range("A2").AutoFilter Field:=i
End If
Next i

i = 1
For Each C In .Range("A2", [A65536].End(xlUp)).SpecialCells(xlCellTypeVisible)
If C.Row = 1 Then Exit For
ListView1.ListItems.Add , "K" & i, C 'non
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 6) 'societe
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 64) 'Categorie

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 94) 'Membre
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 12) 'ville
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 14) 'code postal
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 9) 'rue
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 15) 'pays

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 93) 'crée le
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 13) 'region

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 32) 'tel bureau
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 38) 'tel domicile
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 31) 'fax
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 35) 'gsm
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 80) 'page web
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 49) 'email
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 2) 'prenom
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 3) 'deuxieme prenom
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 58) 'anniversaire
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 1) 'titre
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 5) 'sufix
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 78) 'commentaire
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 96) 'continent1
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 95) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 98) 'continent2
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 97) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 100) 'continent3
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 99) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 101) 'continent4
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 102) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 104) 'continent
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 103) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 106) 'continent
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 105) 'pays visiité

.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 108) 'continent
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("Data").Cells(i, 107) 'pays visiité



i = i + 1
Next C

End With

For x = 1 To ListView1.ListItems.Count
If ListView1.ListItems(x) = UCase("p") Then
ListView1.ListItems(x).ForeColor = &HFF0000
For J = 1 To 26
ListView1.ListItems(x).ListSubItems(J).ForeColor = &HFF0000
Next
End If
Next
Alim_Combo


End Sub

Private Sub Vide_Combo(Optional Cb As Byte)
Dim k As Byte
For k = 1 To 26
If k <> Cb Then Controls("Cbx" & k).ListIndex = -1
Next
End Sub
 

BERRACHED said

XLDnaute Accro
Re : eurreur dans un code de filtration

Salut,geraldvc

eh ben mon cher ami ton sujet il faudra le parcourir a Bicyclette :D.

Essayé de compresser ton fichier et le déposer ICI c'est un service de dépôt gratuit et nous communiquer le lien par la suite

comme ça les gens peuvent te donner un coup de main.

Cordialement
 

Discussions similaires