cco86260
Messages postés166Date d'inscriptiondimanche 22 janvier 2012StatutMembreDernière intervention30 juillet 2015
-
29 juil. 2015 à 08:36
cco86260
Messages postés166Date d'inscriptiondimanche 22 janvier 2012StatutMembreDernière intervention30 juillet 2015
-
30 juil. 2015 à 14:33
Bonjour à tous,
Donc voilà, j'ai un soucis avec une listbox, je vous explique ce que je voudrais faire avec.
J'ai un tableau de plusieurs ligne, chaque ligne constitue un rapport d'expertise, j'ai un bouton "creer fiches", lorsque je clique, un USF s'ouvre, il est composé de 4 combobox servant a la recherche
Cbb 1 = recherche par site
Cbb 2 = recherche par type d'ancrage
Cbb 3 = recherche par N° d'OI
Cbb 4 = recherche par date (qui me pose également un soucis, lorsque je selectionne la date, la listbox se vide)
Donc, un fois mes recherche faite (sans la date du coup), les fiches souhaité s'affiche, et si je selectionne une ou plusieurs fiches, et que je lance les rapports, il ne me sort pas les bonne fiche (il me prend la première ligne du tableau)... je vous montre le code, car là je sèche, ou alors il y a une chose que je ne pas compris...
Voici 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, Photo1 As String, Photo2 As String, Photo3 As String Dim nbToGo As Integer Dim premier
Set dicoType = CreateObject("Scripting.Dictionary") Set dicoOI = CreateObject("Scripting.Dictionary") Set dicoDate = CreateObject("Scripting.Dictionary")
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 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")
ListBox1.ColumnCount = 5 ListBox1.ColumnWidths = "72;84;60;95;102" 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
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("BC" & 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("AN129").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
Photo1 = classeurphoto & Format(bdd.Worksheets("BDD").Range("AX" & i + 4).Value, "0000") & ".jpg" If Dir(Photo1) <> "" Then Sheets(nrapex).Image1.Picture = LoadPicture(Photo1) Sheets(nrapex).Range("T263") = numphoto1 End If
Photo2 = classeurphoto & Format(bdd.Worksheets("BDD").Range("AY" & i + 4).Value, "0000") & ".jpg" If Dir(Photo2) <> "" Then Sheets(nrapex).Image2.Picture = LoadPicture(Photo2) Sheets(nrapex).Range("AL263") = numphoto2 End If Sheets(nrapex).Range("F266") = bdd.Worksheets("BDD").Range("BC" & i + 4).Value 'Description du constat Sheets(nrapex).Range("T261") = bdd.Worksheets("BDD").Range("AV" & i + 4).Value 'N° du constat Sheets(nrapex).Range("AL261") = bdd.Worksheets("BDD").Range("AW" & i + 4).Value 'N° de la fiche d'ecart
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
J'espère pour une fois avoir été assez explicite sur mon problème et vous remercie pour votre aide
Bonjour,
Trop de lignes de code à analyser. Cela reviendrait à se mettre totalement dans le bain que tu as créé, à tout analyser puis à tout corriger. Ce n'est pas vraiment le but de ce forum. Et ce d'autant qu'il faudrait, pour y parvenir, reconstruire un projet à l'identique !
Travaille pas à pas. Utilise également debug Print. Cela devrait te permettre de localiser ce qui ne va pas et de nous exposer que cette difficulté-là.
J'ai parcouru en "diagonale" tes lignes de code. Elles manquent de rigueur ici et là ...
Quelques "libertés" malheureuses, entre autres :
1) aucun type défini pour ces variables, dont certaines sont en plus des objets
Dim f, dico, C, temp, a, gauc, droi, d, g, ref, tempo, plage, ln
Dim dicoSite, dicoType, dicoDate, dicoOI, i
Dim premier
2) il est maladroit d'utiliser la propriété par défaut d'un objet, même si VBA se montre tolérant exemple :
If C.Value = ComboBox1 Then '===>>> précise la propriété utilisée de cette Combo
3) il est maladroit de créer des dictionnaires à chaque fois qu'intervient un évènement !
Set dicoType = CreateObject("Scripting.Dictionary")
Set dicoOI = CreateObject("Scripting.Dictionary")
Set dicoDate = CreateObject("Scripting.Dictionary")
Ils sont à créer une fois pour toutes lors de l'ouverture du userform)
4) il est maladroit de confondre l'évènement change d'une combobox avec son évènement click
l'évènement change intervient bien lorsqu'un article y est sélectionné, mais il intervient également lorsque l'utilisateur appuie sur une touche alors qu'il est dans la zone d'édition de cette combobox, sans que cela n'entraîne la sélection d'un article !
Pire : il intervient également lorsque tu vides la combobox. Or, je vois que tel est le cas pour toutes tes comboboxes !
etc... etc ...
Reprends à zéro et méticuleusement tout ce travail
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
cco86260
Messages postés166Date d'inscriptiondimanche 22 janvier 2012StatutMembreDernière intervention30 juillet 20152 30 juil. 2015 à 14:06
Bonjour ucfoutu,
Comment vas-tu ?
Merci pour ta réponse, effectivement je n'avais pas pensé ce que vous impliquait tout ce code, de plus effectivement mal écrit, soyons franc, mais j'ai toujours un peu de mal avec l'organisation.
Mais ma seul question réside dans ce problème de listbox, comment lui faire comprendre que si je prend un fiche ou plusieur, il me prenne les bonne dans ce tableau..., je vais quand même réécrire le code...
Je ne sais pas utiliser les debug.Print (ce qui à priori est primordiale en VBA), je crois que google va être mon ami pour longtemps... ;)
Cependant je suis preneur de tes précieux conseil et remarque