Filtre par date dans listbox

Le 26/07/2015 à 13:01

Bonjour à tous,

J'ai un soucis, j'ai un USF composé de :

2 ComboBox >> 1 pour filtrer sur les date et 1 pour filtrer par site

1 BDD excel

Le but est que lorsque nous faisons les inspections, on puisse créer les rapports par date

ce que je souhaite est donc que lorsque je choisi dans mon combo Date un date, puis dans le 2 le site, il me liste dans la listbox1 les données correspondante... j'ai essayé avec ce code mais ça ne fonctionne pas... j'ai pas du tout comprendre sur les dictionnaire...

Voici le code en question :

Option Explicit
Dim f, dico, C, temp, a, gauc, droi, d, g, ref, tempo, plage, ln
Dim dicoSite, dicoTranche, dicoDate, dicoOI, i
Dim bdd As Workbook, rapex As Workbook
Dim rep As String, classeurpath As String, classeurphoto As String, classeurplan As String
Dim nrapex As String
Dim ligne_fin As String
Dim typeanc As String, tr As String, syst As String, nmat As String, bigramme As String, dimampdirsens As String
Dim numconstat As String, numécart As String, numphoto1 As String, numphoto2 As String, piecerempllot1 As String
Dim piecerempllot2 As String, piecerempllot3 As String, descriptconstasol As String
Dim nbToGo As Integer
Dim premier

Private Sub ComboBox1_Change()

Set plage = f.Range("BD4:BD" & f.Range("BD" & Rows.Count).End(xlUp).Row)
ComboBox2.Clear
Set dicoSite = CreateObject("Scripting.Dictionary")
dicoSite.RemoveAll

For Each C In plage
    If C.Value = ComboBox1 Then
        dicoSite(C.Offset(0, 1).Value) = ""
    End If
Next C
ComboBox2.List = dicoSite.Keys
Call ChargementListBox1

End Sub

Private Sub ComboBox2_Change()
Call ChargementListBox1
End Sub
Sub ChargementListBox1()
    Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
    ListBox1.Clear

        For Each C In plage
            If (C.Value = ComboBox1 Or ComboBox1 = "") And (C.Offset(0, 1).Value = ComboBox2 Or ComboBox2 = "") Then
                ListBox1.AddItem
                ListBox1.Column(0, ListBox1.ListCount - 1) = C.Value
                ListBox1.Column(1, ListBox1.ListCount - 1) = C.Offset(0, 1).Value
                ListBox1.Column(2, ListBox1.ListCount - 1) = C.Offset(0, 2).Value
                ListBox1.Column(0, ListBox1.ListCount - 1) = C.Offset(0, 9).Value
            End If
        Next C

End Sub
Private Sub UserForm_Initialize()

        Set dicoSite = CreateObject("Scripting.Dictionary")
        Set dicoOI = CreateObject("Scripting.Dictionary")
        Set dicoDate = CreateObject("Scripting.Dictionary")
        Set f = Sheets("BDD")
        Set dico = CreateObject("Scripting.Dictionary")

    ' Charger le combo site

            Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox2.List = temp

    ' Charger le combo Date

            Set plage = f.Range("BD4:BD" & f.Range("BD" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox1.List = temp

    ' Définition de la listbox

            ListBox1.ColumnCount = 4
            ListBox1.ColumnWidths = "100;100;100;100"
End Sub
Sub ChargerCBB()

        For Each C In plage
            dico(C.Value) = C.Value
        Next C
        temp = dico.Keys
        Call Tri(temp, LBound(temp), UBound(temp))

End Sub
Sub Tri(a, gauc, droi) ' Quick sort
   ref = a((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
       tempo = a(g): a(g) = a(d): a(d) = tempo
       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 CheckBox1_Click()
Dim j&
If CheckBox1 Then
    CheckBox1.Caption = "Tout désélectionner"
        For j = 0 To ListBox1.ListCount - 1
            ListBox1.Selected(j) = 1
        Next j
    Else
    CheckBox1.Caption = "Tout sélectionner"
        For j = 0 To ListBox1.ListCount - 1
            ListBox1.Selected(j) = 0
        Next j
End If
End Sub

Private Sub Cmd_PDF_Click()

    rep = Environ("USERPROFILE") & "\"
    classeurpath = rep & "Documents\InspectionAncrages\Rapports_expertise\rap_exp_chevilles.xlsm"
    classeurphoto = rep & "Documents\InspectionAncrages\Photos"
    classeurplan = rep & " Documents\InspectionAncrages\Plans"
    'ligne_fin = Cells.Find("*", Range("J1"), , , xlByRows, xlPrevious).Row

Set bdd = ThisWorkbook
Set rapex = Workbooks.Open(classeurpath)
nbToGo = ListBox1.ListCount

For i = 0 To nbToGo - 1
'Application.ScreenUpdating = False
    If ListBox1.Selected(i) = True Then
        'LI = i 'à adapter
       DoEvents
        'Creer_rapports
            With rapex.Worksheets("RE_Type_Cheville")
                    nrapex = CStr(bdd.Worksheets("BDD").Range("J" & i + 4))
                    rapex.Worksheets("RE_Type_Cheville").Copy Before:=rapex.Worksheets("RE_Type_Cheville")
                    ActiveSheet.Name = nrapex
            ' Renseignement sur l'inspection

        typeanc = bdd.Worksheets("BDD").Range("Q" & i + 4).Value              ' Valeur de la variable type d'ancrage
        tr = bdd.Worksheets("BDD").Range("E" & i + 4).Value                   ' Valeur de la variable tranche
        syst = bdd.Worksheets("BDD").Range("F" & i + 4).Value                 ' Valeur de la variable système
        nmat = bdd.Worksheets("BDD").Range("G" & i + 4).Value                 ' Valeur de la variable numéro de matériel
        bigramme = bdd.Worksheets("BDD").Range("H" & i + 4).Value             ' Valeur de la variable bigramme
        dimampdirsens = bdd.Worksheets("BDD").Range("AF" & i + 4).Value
        numconstat = bdd.Worksheets("BDD").Range("AV" & i + 4).Value
        numécart = bdd.Worksheets("BDD").Range("AW" & i + 4).Value
        numphoto1 = bdd.Worksheets("BDD").Range("AX" & i + 4).Value
        numphoto2 = bdd.Worksheets("BDD").Range("AY" & i + 4).Value
        piecerempllot1 = bdd.Worksheets("BDD").Range("AZ" & i + 4).Value
        piecerempllot2 = bdd.Worksheets("BDD").Range("BA" & i + 4).Value
        piecerempllot3 = bdd.Worksheets("BDD").Range("BB" & i + 4).Value
        descriptconstasol = bdd.Worksheets("BDD").Range("BB" & i + 4).Value

    ' On écrit les valeurs dans le rapport

        Sheets(nrapex).Range("AE13") = bdd.Worksheets("BDD").Range("A" & i + 4).Value
        Sheets(nrapex).Range("A13") = bdd.Worksheets("BDD").Range("C" & i + 4).Value
        Sheets(nrapex).Range("K13") = bdd.Worksheets("BDD").Range("D" & i + 4).Value
        Sheets(nrapex).Range("S14") = bdd.Worksheets("BDD").Range("I" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("B" & i + 4).Value
                        Case Is = "ECOT VD3"
                        Sheets(nrapex).Range("V16").Value = "X"
                        'Case Is = PBMP & " " & "## ###-##"
                        'Sheets(nrapex).Range("AC16").Value = "X"
                        Case Is = "AUTRE"
                        Sheets(nrapex).Range("AQ16").Value = "X"
                End Select

                If Left(bdd.Worksheets("BDD").Range("B" & i + 4).Value, 4) = "PBMP" Then
                    Sheets(nrapex).Range("AC16").Value = "X"
                    Sheets(nrapex).Range("AF16").Value = Right(bdd.Worksheets("BDD").Range("B" & i + 4).Value, 9)
                End If

        Sheets(nrapex).Range("A26") = bdd.Worksheets("BDD").Range("K" & i + 4).Value
        Sheets(nrapex).Range("Q26") = bdd.Worksheets("BDD").Range("L" & i + 4).Value
        Sheets(nrapex).Range("AI26") = bdd.Worksheets("BDD").Range("M" & i + 4).Value
        Sheets(nrapex).Range("AN70") = bdd.Worksheets("BDD").Range("J" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("R" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN73").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS73").Value = "X"
                End Select

        Sheets(nrapex).Range("AI75") = bdd.Worksheets("BDD").Range("S" & i + 4).Value
        Sheets(nrapex).Range("AI76") = bdd.Worksheets("BDD").Range("T" & i + 4).Value
        Sheets(nrapex).Range("AI77") = bdd.Worksheets("BDD").Range("U" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("V" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN79").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS79").Value = "X"
                End Select

        Sheets(nrapex).Range("AI81") = bdd.Worksheets("BDD").Range("T" & i + 4).Value
        Sheets(nrapex).Range("AI82") = bdd.Worksheets("BDD").Range("S" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("Y" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN84").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS84").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("Z" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN87").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS87").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AA" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN90").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS90").Value = "X"
                End Select

        Sheets(nrapex).Range("AI92") = bdd.Worksheets("BDD").Range("AB" & i + 4).Value

             ' Etat du génie civile au voisinage des ancrages

                Select Case bdd.Worksheets("BDD").Range("AC" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN95").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS95").Value = "X"
                End Select

        Sheets(nrapex).Range("AM97") = bdd.Worksheets("BDD").Range("AD" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AE" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN100").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS100").Value = "X"
                End Select

        'Sheets(nrapex).Range("") = dimampdirsens

                Select Case bdd.Worksheets("BDD").Range("AG" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN105").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS105").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = bdd.Worksheets("BDD").Range("AH" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AI" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN110").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS110").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = bdd.Worksheets("BDD").Range("AJ" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AK" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN115").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS115").Value = "X"
                End Select

        ' ETAT DE LA CORROSION (Controle visuel sur la platine et les parties visible des chevilles

                Select Case bdd.Worksheets("BDD").Range("AL" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN119").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS119").Value = "X"
                End Select

        Sheets(nrapex).Range("AI121") = bdd.Worksheets("BDD").Range("AM" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AN" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN123").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS123").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AO" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN126").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS126").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AP" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN1129").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS129").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AQ" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN132").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS132").Value = "X"
                End Select

             ' Vérification de scellement (conformément au logigramme)

                Select Case bdd.Worksheets("BDD").Range("AR" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN136").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS136").Value = "X"
                End Select

        Sheets(nrapex).Range("AI138") = bdd.Worksheets("BDD").Range("AS" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AT" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN140").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS140").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AU" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN143").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS143").Value = "X"
                End Select

            End With
            End If
            'Application.ScreenUpdating = True
            Next i
            Unload Me

            ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            ' !!CODE A FINIR POUR LES CONSTATS ET LES PIECE A REMPLACER!!
            ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
End Sub
Private Sub cmd_fermer_Click()
    Unload Me
End Sub

Merci à tous pour votre aide,

Chris

Le 26/07/2015 à 14:29

Bonjour,

Si tu ne joins pas ton fichier, si besoin anonymisé, il sera difficile de t'aider.

Bye !

Le 26/07/2015 à 14:50

Salut gmb,

Je joint le fichier anonymisé, le formulaire permettant de creer les fiche se nomme "INSP_Fiches". Le dossier " InspectionAncrage" et à placer dans le dossier "Documents".

J'ai été obliger de virer le fichiers des rapports car trop volumineux sinon.

Tu verras, j'ai repris selon le code que tu m'as fournis, mais j'ai du caffouiller, je n'ai pas trop compris je pense...

Merci pour ton aide

51inspectionancrages.zip (226.18 Ko)
Le 26/07/2015 à 16:56

Re,

Donc, j'essaye encore de comprendre, mais bon... voici un petit avancement..., maintenant, lorsque je sélectionne le site il m'affiche bien tout ce qui à été inspecté sur ce site, mais lorsque je choisi la date, la listbox se vide complètement, voici les codes :

Option Explicit
Dim f, dico, C, temp, a, gauc, droi, d, g, ref, tempo, plage, ln
Dim dicoSite, dicoTranche, dicoDate, dicoOI, i
Dim bdd As Workbook, rapex As Workbook
Dim rep As String, classeurpath As String, classeurphoto As String, classeurplan As String
Dim nrapex As String
Dim ligne_fin As String
Dim typeanc As String, tr As String, syst As String, nmat As String, bigramme As String, dimampdirsens As String
Dim numconstat As String, numécart As String, numphoto1 As String, numphoto2 As String, piecerempllot1 As String
Dim piecerempllot2 As String, piecerempllot3 As String, descriptconstasol As String
Dim nbToGo As Integer
Dim premier

Private Sub ComboBox1_Change() ' ComboBox Site

Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
ComboBox2.Clear
Set dicoDate = CreateObject("Scripting.Dictionary")
dicoDate.RemoveAll

For Each C In plage
    If C.Value = ComboBox1 Then
        dicoDate(C.Offset(0, 55).Value) = ""
    End If
Next C
ComboBox2.List = dicoDate.Keys
Call ChargementListBox1

End Sub

Private Sub ComboBox2_Change() ' ComboBox Date

Call ChargementListBox1

End Sub
Sub ChargementListBox1()
    Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
    ListBox1.Clear

        For Each C In plage
            If (C.Value = ComboBox1 Or ComboBox1 = "") And (C.Offset(0, 55).Value = ComboBox2 Or ComboBox2 = "") Then
                ListBox1.AddItem
                ListBox1.Column(0, ListBox1.ListCount - 1) = C.Offset(0, 55).Value
                ListBox1.Column(1, ListBox1.ListCount - 1) = C.Value
                ListBox1.Column(2, ListBox1.ListCount - 1) = C.Offset(0, 2).Value
                ListBox1.Column(3, ListBox1.ListCount - 1) = C.Offset(0, 9).Value
            End If
        Next C

End Sub
Private Sub UserForm_Initialize()

        Set dicoSite = CreateObject("Scripting.Dictionary")
        Set dicoDate = CreateObject("Scripting.Dictionary")
        Set f = Sheets("BDD")
        Set dico = CreateObject("Scripting.Dictionary")

    ' Charger le combo site

            Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox1.List = temp

    ' Charger le combo Date

            Set plage = f.Range("BD4:BD" & f.Range("BD" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox2.List = temp

    ' Définition de la listbox

            ListBox1.ColumnCount = 4
            ListBox1.ColumnWidths = "72;84;60;95"
End Sub
Sub ChargerCBB()

        For Each C In plage
            dico(C.Value) = C.Value
        Next C
        temp = dico.Keys
        Call Tri(temp, LBound(temp), UBound(temp))

End Sub
Sub Tri(a, gauc, droi) ' Quick sort
   ref = a((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
       tempo = a(g): a(g) = a(d): a(d) = tempo
       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

Encore merci

Chris

Le 27/07/2015 à 16:24

Bonjour à tous,

Je fais un petit up sur on sujet avec quelques "améliorations",

Donc finalement, je me base sur 4 critères de recherches, c'est à dire :

Site ; type d'ancrage ; N° d'OI ; Date

ça fonctionne, sauf, que lorsque je choisi la date, ça me vide la listbox, de plus, je ne comprend pas pourquoi, lorsque je sélectionne une fiche, il me sort celle qui est au début du tableau BDD. Je vous met le code.

Option Explicit
Dim f, dico, C, temp, a, gauc, droi, d, g, ref, tempo, plage, ln
Dim dicoSite, dicoType, dicoDate, dicoOI, i
Dim bdd As Workbook, rapex As Workbook
Dim rep As String, classeurpath As String, classeurphoto As String, classeurplan As String
Dim nrapex As String
Dim ligne_fin As String
Dim typeanc As String, tr As String, syst As String, nmat As String, bigramme As String, dimampdirsens As String
Dim numconstat As String, numécart As String, numphoto1 As String, numphoto2 As String, piecerempllot1 As String
Dim piecerempllot2 As String, piecerempllot3 As String, descriptconstasol As String
Dim nbToGo As Integer
Dim premier

Private Sub ComboBox1_Change() ' ComboBox Site

Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
ComboBox2.Clear: ComboBox3.Clear: ComboBox4.Clear

Set dicoType = CreateObject("Scripting.Dictionary")
Set dicoOI = CreateObject("Scripting.Dictionary")
Set dicoDate = CreateObject("Scripting.Dictionary")

dicoType.RemoveAll: dicoOI.RemoveAll: dicoDate.RemoveAll

For Each C In plage
    If C.Value = ComboBox1 Then
        dicoType(C.Offset(0, 16).Value) = ""
        dicoOI(C.Offset(0, 2).Value) = ""
        dicoDate(C.Offset(0, 55).Value) = ""
    End If
Next C
ComboBox2.List = dicoType.Keys
ComboBox3.List = dicoOI.Keys
ComboBox4.List = dicoDate.Keys
Call ChargementListBox1

End Sub

Private Sub ComboBox2_Change() ' ComboBox Date

Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
    ComboBox3.Clear: ComboBox4.Clear
    dicoOI.RemoveAll: dicoDate.RemoveAll
    For Each C In plage
        If C.Value = ComboBox1 And C.Offset(0, 16).Value = ComboBox2 Then
            dicoOI(C.Offset(0, 2).Value) = ""
            dicoDate(C.Offset(0, 55).Value) = ""
        End If
    Next C
    ComboBox3.List = dicoOI.Keys
    ComboBox4.List = dicoDate.Keys
    Call ChargementListBox1

End Sub
Private Sub ComboBox3_Change()

Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
    ComboBox4.Clear
    dicoDate.RemoveAll
    For Each C In plage
        If C.Value = ComboBox1 And C.Offset(0, 16).Value = ComboBox2 And C.Offset(0, 2).Value = ComboBox3 Then
            dicoDate(C.Offset(0, 55).Value) = ""
        End If
    Next C
    ComboBox4.List = dicoDate.Keys
    Call ChargementListBox1

End Sub
Private Sub ComboBox4_Change()
Call ChargementListBox1
End Sub

Sub ChargementListBox1()
    Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
    ListBox1.Clear

        For Each C In plage
            If (C.Value = ComboBox1 Or ComboBox1 = "") And (C.Offset(0, 16).Value = ComboBox2 Or ComboBox2 = "") _
                                                    And (C.Offset(0, 2).Value = ComboBox3 Or ComboBox3 = "") _
                                                    And (C.Offset(0, 55).Value = ComboBox4 Or ComboBox4 = "") Then
                ListBox1.AddItem
                ListBox1.Column(0, ListBox1.ListCount - 1) = C.Offset(0, 55).Value
                ListBox1.Column(1, ListBox1.ListCount - 1) = C.Value
                ListBox1.Column(2, ListBox1.ListCount - 1) = C.Offset(0, 2).Value
                ListBox1.Column(3, ListBox1.ListCount - 1) = C.Offset(0, 9).Value
            End If
        Next C

End Sub

Private Sub UserForm_Initialize()

        Set dicoSite = CreateObject("Scripting.Dictionary")
        Set dicoDate = CreateObject("Scripting.Dictionary")
        Set dicoType = CreateObject("Scripting.Dictionary")
        Set dicoOI = CreateObject("Scripting.Dictionary")
        Set f = Sheets("BDD")
        Set dico = CreateObject("Scripting.Dictionary")

    ' Charger le combo site

            Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox1.List = temp

    ' Charger le combo type d'ancrage

            Set plage = f.Range("Q4:Q" & f.Range("Q" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox2.List = temp

    ' Charger le N° d'OI

            Set plage = f.Range("C4:C" & f.Range("C" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox3.List = temp

    ' Charger la date d'inspection

            Set plage = f.Range("BD4:BD" & f.Range("BD" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox4.List = temp

    ' Définition de la listbox

            ListBox1.ColumnCount = 4
            ListBox1.ColumnWidths = "72;84;60;95"
End Sub
Sub ChargerCBB()

        For Each C In plage
            dico(C.Value) = C.Value
        Next C
        temp = dico.Keys
        Call Tri(temp, LBound(temp), UBound(temp))

End Sub
Sub Tri(a, gauc, droi) ' Quick sort
   ref = a((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
       tempo = a(g): a(g) = a(d): a(d) = tempo
       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 CheckBox1_Click()
Dim j&
If CheckBox1 Then
    CheckBox1.Caption = "Tout désélectionner"
        For j = 0 To ListBox1.ListCount - 1
            ListBox1.Selected(j) = 1
        Next j
    Else
    CheckBox1.Caption = "Tout sélectionner"
        For j = 0 To ListBox1.ListCount - 1
            ListBox1.Selected(j) = 0
        Next j
End If
End Sub

Private Sub Cmd_PDF_Click()

    rep = Environ("USERPROFILE") & "\"
    classeurpath = rep & "Documents\InspectionAncrages\Rapports_expertise\rap_exp_chevilles.xlsm"
    classeurphoto = rep & "Documents\InspectionAncrages\Photos"
    classeurplan = rep & " Documents\InspectionAncrages\Plans"
    'ligne_fin = Cells.Find("*", Range("J1"), , , xlByRows, xlPrevious).Row

Set bdd = ThisWorkbook
Set rapex = Workbooks.Open(classeurpath)
nbToGo = ListBox1.ListCount

For i = 0 To nbToGo - 1
'Application.ScreenUpdating = False
    If ListBox1.Selected(i) = True Then
        'LI = i 'à adapter
       DoEvents
        'Creer_rapports
            With rapex.Worksheets("RE_Type_Cheville")
                    nrapex = CStr(bdd.Worksheets("BDD").Range("J" & i + 4))
                    rapex.Worksheets("RE_Type_Cheville").Copy Before:=rapex.Worksheets("RE_Type_Cheville")
                    ActiveSheet.Name = nrapex
            ' Renseignement sur l'inspection

        typeanc = bdd.Worksheets("BDD").Range("Q" & i + 4).Value              ' Valeur de la variable type d'ancrage
        tr = bdd.Worksheets("BDD").Range("E" & i + 4).Value                   ' Valeur de la variable tranche
        syst = bdd.Worksheets("BDD").Range("F" & i + 4).Value                 ' Valeur de la variable système
        nmat = bdd.Worksheets("BDD").Range("G" & i + 4).Value                 ' Valeur de la variable numéro de matériel
        bigramme = bdd.Worksheets("BDD").Range("H" & i + 4).Value             ' Valeur de la variable bigramme
        dimampdirsens = bdd.Worksheets("BDD").Range("AF" & i + 4).Value
        numconstat = bdd.Worksheets("BDD").Range("AV" & i + 4).Value
        numécart = bdd.Worksheets("BDD").Range("AW" & i + 4).Value
        numphoto1 = bdd.Worksheets("BDD").Range("AX" & i + 4).Value
        numphoto2 = bdd.Worksheets("BDD").Range("AY" & i + 4).Value
        piecerempllot1 = bdd.Worksheets("BDD").Range("AZ" & i + 4).Value
        piecerempllot2 = bdd.Worksheets("BDD").Range("BA" & i + 4).Value
        piecerempllot3 = bdd.Worksheets("BDD").Range("BB" & i + 4).Value
        descriptconstasol = bdd.Worksheets("BDD").Range("BB" & i + 4).Value

    ' On écrit les valeurs dans le rapport

        Sheets(nrapex).Range("AE13") = bdd.Worksheets("BDD").Range("A" & i + 4).Value
        Sheets(nrapex).Range("A13") = bdd.Worksheets("BDD").Range("C" & i + 4).Value
        Sheets(nrapex).Range("K13") = bdd.Worksheets("BDD").Range("D" & i + 4).Value
        Sheets(nrapex).Range("S14") = bdd.Worksheets("BDD").Range("I" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("B" & i + 4).Value
                        Case Is = "ECOT VD3"
                        Sheets(nrapex).Range("V16").Value = "X"
                        'Case Is = PBMP & " " & "## ###-##"
                        'Sheets(nrapex).Range("AC16").Value = "X"
                        Case Is = "AUTRE"
                        Sheets(nrapex).Range("AQ16").Value = "X"
                End Select

                If Left(bdd.Worksheets("BDD").Range("B" & i + 4).Value, 4) = "PBMP" Then
                    Sheets(nrapex).Range("AC16").Value = "X"
                    Sheets(nrapex).Range("AF16").Value = Right(bdd.Worksheets("BDD").Range("B" & i + 4).Value, 9)
                End If

        Sheets(nrapex).Range("A26") = bdd.Worksheets("BDD").Range("K" & i + 4).Value
        Sheets(nrapex).Range("Q26") = bdd.Worksheets("BDD").Range("L" & i + 4).Value
        Sheets(nrapex).Range("AI26") = bdd.Worksheets("BDD").Range("M" & i + 4).Value
        Sheets(nrapex).Range("AN70") = bdd.Worksheets("BDD").Range("J" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("R" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN73").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS73").Value = "X"
                End Select

        Sheets(nrapex).Range("AI75") = bdd.Worksheets("BDD").Range("S" & i + 4).Value
        Sheets(nrapex).Range("AI76") = bdd.Worksheets("BDD").Range("T" & i + 4).Value
        Sheets(nrapex).Range("AI77") = bdd.Worksheets("BDD").Range("U" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("V" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN79").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS79").Value = "X"
                End Select

        Sheets(nrapex).Range("AI81") = bdd.Worksheets("BDD").Range("T" & i + 4).Value
        Sheets(nrapex).Range("AI82") = bdd.Worksheets("BDD").Range("S" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("Y" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN84").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS84").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("Z" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN87").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS87").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AA" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN90").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS90").Value = "X"
                End Select

        Sheets(nrapex).Range("AI92") = bdd.Worksheets("BDD").Range("AB" & i + 4).Value

             ' Etat du génie civile au voisinage des ancrages

                Select Case bdd.Worksheets("BDD").Range("AC" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN95").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS95").Value = "X"
                End Select

        Sheets(nrapex).Range("AM97") = bdd.Worksheets("BDD").Range("AD" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AE" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN100").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS100").Value = "X"
                End Select

        'Sheets(nrapex).Range("") = dimampdirsens

                Select Case bdd.Worksheets("BDD").Range("AG" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN105").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS105").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = bdd.Worksheets("BDD").Range("AH" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AI" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN110").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS110").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = bdd.Worksheets("BDD").Range("AJ" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AK" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN115").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS115").Value = "X"
                End Select

        ' ETAT DE LA CORROSION (Controle visuel sur la platine et les parties visible des chevilles

                Select Case bdd.Worksheets("BDD").Range("AL" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN119").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS119").Value = "X"
                End Select

        Sheets(nrapex).Range("AI121") = bdd.Worksheets("BDD").Range("AM" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AN" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN123").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS123").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AO" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN126").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS126").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AP" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN1129").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS129").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AQ" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN132").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS132").Value = "X"
                End Select

             ' Vérification de scellement (conformément au logigramme)

                Select Case bdd.Worksheets("BDD").Range("AR" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN136").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS136").Value = "X"
                End Select

        Sheets(nrapex).Range("AI138") = bdd.Worksheets("BDD").Range("AS" & i + 4).Value

                Select Case bdd.Worksheets("BDD").Range("AT" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN140").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS140").Value = "X"
                End Select

                Select Case bdd.Worksheets("BDD").Range("AU" & i + 4).Value
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN143").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS143").Value = "X"
                End Select

            End With
            End If
            'Application.ScreenUpdating = True
            Next i
            Unload Me

            ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            ' !!CODE A FINIR POUR LES CONSTATS ET LES PIECE A REMPLACER!!
            ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
End Sub
Private Sub cmd_fermer_Click()
    Unload Me
End Sub

Pour info, Je selectionne le site, le type d'ancrage, le numero d'OI (jusqu'ici ça se passe bien) ensuite, des que je prend la date, plus rien dans la listbox, si je ne prend pas de date, mais que je choisi une fiche dans la listbox, il ne me sort pas la bonne.

Vous pouvez copier tout le code dans "INSP_Fiches"

Merci pour votre aide, car là je sèche complètement

Bonne journée a tous

Et merci

Chris

Le 30/07/2015 à 11:25

Bonjour a tous,

Je suis toujours avec mon soucis, pourriez-vous m'expliquer ce qui ne va pas, car en analysant le problème, je me rend compte que :

Dans ma listbox, si je sélectionne une fiche (la première de la liste par exemple), il me sort la première du tableau, si l'on peut m'aider juste sur ce point, cela m'aiderait peut être à comprendre...

Merci a tous

Chris

Le 31/07/2015 à 10:15

Salut,

Toujours personne ? ;(

Y'aurait il une raison ?

Chris

Le 31/07/2015 à 21:01

Bonjour

J'avais regardé cela il y a quelque jours

A vérifier car je nais plus ce que j'avais fait

79inspection-ancrage-v001.xlsm (164.63 Ko)
Le 03/08/2015 à 15:15

Salut Banzaï64,

Comment vas tu ?

Merci pour la modif, ça fonctionne, parcontre, il y a juste un changement mineur au niveau des critères de recherches, ce n'est plus "Date" et "Site" mais "Date" et "N° d'OI"

J'essaye donc de modifier, mais à chaque fois il m'affiche les site dans le combo2

Aurais-je mal compris le fonctionnement ? voici le code modifié :

Private Sub ComboBox1_Change()
' Les dates
Dim Ladate

    If Me.ComboBox1.ListIndex <> -1 Then
      Ladate = CDate(Me.ComboBox1)
    Else
      Ladate = "*"
    End If

  Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
  ComboBox2.Clear
  'Set dicoOI = CreateObject("Scripting.Dictionary")
  dicoOI.RemoveAll

  For Each C In plage
    If C.Offset(0, 55).Value Like Ladate Then
      dicoOI(C.Value) = ""
    End If
  Next C
  ComboBox2.List = dicoOI.Keys
  Call ChargementListBox1

End Sub

Private Sub ComboBox2_Change()
' Les N° d'OI
Call ChargementListBox1
End Sub

Sub ChargementListBox1()
Dim Ladate

    Set plage = f.Range("A4:A" & f.Range("A" & Rows.Count).End(xlUp).Row)
    ListBox1.Clear
    If Me.ComboBox1.ListIndex <> -1 Then
      Ladate = CDate(Me.ComboBox1)
    Else
      Ladate = "*"
    End If

        For Each C In plage
            If (C.Value Like ComboBox2 & "*") And (C.Offset(0, 55).Value Like Ladate) Then

                ListBox1.AddItem
                ListBox1.Column(0, ListBox1.ListCount - 1) = C.Offset(0, 55).Value
                ListBox1.Column(1, ListBox1.ListCount - 1) = C.Value
                ListBox1.Column(2, ListBox1.ListCount - 1) = C.Offset(0, 2).Value
                ListBox1.Column(3, ListBox1.ListCount - 1) = C.Offset(0, 9).Value
                ListBox1.Column(4, ListBox1.ListCount - 1) = C.Offset(0, 16).Value
            End If
        Next C

End Sub

Private Sub UserForm_Initialize()

        'Set dicoSite = CreateObject("Scripting.Dictionary")
        Set dicoDate = CreateObject("Scripting.Dictionary")
        'Set dicoType = CreateObject("Scripting.Dictionary")
        Set dicoOI = CreateObject("Scripting.Dictionary")
        Set f = Sheets("BDD")
        Set dico = CreateObject("Scripting.Dictionary")

    ' Charger le combo date

            Set plage = f.Range("BD4:BD" & f.Range("BD" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox1.List = temp

    ' Charger le N° d'OI

            Set plage = f.Range("C4:C" & f.Range("C" & Rows.Count).End(xlUp).Row)
            dico.RemoveAll
            Call ChargerCBB
            ComboBox2.List = temp

    ' Définition de la listbox

            ListBox1.ColumnCount = 5
            ListBox1.ColumnWidths = "72;84;60;95;102"
End Sub

Merci pour ton aide, bonne journée

Chris

Le 04/08/2015 à 00:56

Bonjour

Modifie la macro

Call ChargementListBox1
End Sub

Sub ChargementListBox1()
Dim Ladate

    Set plage = f.Range("C4:C" & f.Range("C" & Rows.Count).End(xlUp).Row)
    ListBox1.Clear
    If Me.ComboBox1.ListIndex <> -1 Then
      Ladate = CDate(Me.ComboBox1)
    Else
      Ladate = "*"
    End If

        For Each C In plage
           If (C.Value Like ComboBox2 & "*") And (C.Offset(0, 53).Value Like Ladate) Then

Si pas ça envoie le fichier actuel

Le 04/08/2015 à 08:31

Salut Banzaï64,

Je viens de faire la modif, et j'ai le même résultat, après sélection de la date dans le combo1, le combo2 m'affiche les site au lieu des N° d'OI, les fichiers joints sont comprésser et en 2 parties...

Le dossier "InspectionAncrage" va dans "Documents"

Le fichier "rap_exp_chevilles" va dans "Documents\InspectionAncrages\Rapports_expertise"

Le soucis se trouve dans le module "INSP_Fiches"

Je te remercie pour ton aide, a oui, j'ai par la suite un soucis de sélection dans ce même module, mais là j'aimerais comprendre mon ou mes erreurs, car quand je sélectionne le 1er élément de la listbox (qui peut correspondre a n'importe quelle ligne du taleau), il me sort la première fiche du tableau. J'ai chercher également ce problème mais ... (enfin pour celui là rien ne t'y oblige car ce n'est pas le sujet).

Je te souhaite une bonne journée...

Chris

Re ,

Après correction de mes erreurs (certainement ), le module fonctionne, je te met le nouveau fichier, voir si j'ai bien fait :

Cependant, il me reste le problème de sélection à voir et là c'est la galère

Merci pour ton aide

Chris

22inspectionancrages.zip (238.91 Ko)
27rap-exp-chevilles.xlsm (104.97 Ko)
22inspection-ancrage.xlsm (261.59 Ko)
Le 04/08/2015 à 13:27

Bonjour

A vérifier

48cco86260-inspection-ancrage-v002.xlsm (178.10 Ko)
Le 05/08/2015 à 08:10

Salut Banzaï64,

Super !! tout fonctionne comme je le souhaite, un grand merci à toi pour ton travail, je classe donc ce sujet en résolu, et j'espere que ça servira à d'autre...

Une bonne journée, et encore merci !!

Chris

Rechercher des sujets similaires à "filtre date listbox"