eurreur dans un code de filtration

G

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
 
Trier par date Trier par votes
BERRACHED said

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
 
Vote positif 0 Vote négatif

Discussions similaires

G
  • Question
Autres Exporter listview après un filtrage? bugge (2007)
Réponses
6
Affichages
554
ChTi160
ChTi160
Y
  • Question
XL 2010 remplir listview lignes et colonnes avec un seul ligne horizontale
Réponses
4
Affichages
910
yahya belbachir
Y
D
  • Question
Microsoft 365 VBA Problème dans un évènement Before Save
Réponses
5
Affichages
357
danielco
D
G
  • Résolu(e)
XL 2019 Consigne non suivi dans une suite de ElseIf
Réponses
8
Affichages
174
Gstn
G
F
  • Question
Autres Listview et format de nombre
Réponses
10
Affichages
2 K
FOUQUET Yves
F
S
  • Résolu(e)
Microsoft 365 CODE pour vider un formulaire en évitant les doublons
Réponses
11
Affichages
578
sgangbadjo
S
G
  • Question
XL 2010 Alimenter listview avec 4 Combobox
Réponses
3
Affichages
631
ChTi160
ChTi160
J
  • Question
Autres Problème de compréhension macro
2
Réponses
16
Affichages
2 K
fanch55
fanch55
R
  • Résolu(e)
XL 2016 Un petit coup de main pour un code VBA
Réponses
11
Affichages
277
ReneDav14000
R
PORCHER
  • Question
XL 2016 Erreur d’exécution 35600
Réponses
4
Affichages
619
Staple1600
Staple1600

Membres actuellement en ligne

12 membres et 80 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
304 878
Messages
2 022 700
Membres
222 990
dernier inscrit
lefevreantoine