Créer fiche en fonction d'une listbox

Question

Bonjour à tous,

Donc voilà, je voudrais savoir comment faire pour faire ce qui va suivre :

J'ai un tableau contenant plusieur ligne de données, dans une listbox( à choix multiple), j'affiche le contenu d'une colonne de ce tableau,(ce sont des numéros de fiches), Chaque ligne de ce tableau représente donc une fiche. 

J'aimerais que lorsque que je sélectionne (dans cette listbox) une ou plusieurs fiche il me creer les fiches associées.

Merci pour votre aide

Bonne soirée

jordane45 · Answer

Bonjour,

Déjà... tu as posté ta question dans la section VBA du forum... ok ... mais tu utilises quel logiciel ? ( Word .. Excel...Outlook...ACCESS....CATIA ...??? )
Vu que tu parles de "tableau" je suppose que c'est Excel... mais attendons que tu nous le confirme !

 Chaque ligne de ce tableau représente donc une fiche.
J'aimerais que lorsque que je sélectionne (dans cette listbox) une ou plusieurs fiche il me creer les fiches associées.


.. ces fiches... elles doivent ressembler à quoi ?
=> Autrement dit.. en quoi consiste la "création" de ces fiches ?

Et enfin... sur quoi bloques tu exactement ?
Quel code as tu essayé de mettre en place ?


NB : Merci de bien vouloir utiliser la coloration syntaxique (les balises de code) lorsque tu postes du code sur le forum.
Explications disponibles ici :
http://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

niewbiesVBA · Answer

Bonjour Jordane45, Merci de ta reponse, Je suis sous excel 2013, tout ce passe avec d'ailleur pour mon fichier. Les fiches sont un autre tableau (mis en page), nommé Fvierge, Le tableau ont sont stockés les données de départ est nomée BDD Avec ce tableau BDD, dans un USF, j'ai mis dans le UserForm_Initialize : Private Sub UserForm_Initialize()ListBox1.RowSource = "BDD!G5:G" & Sheets("BDD").Range("G" & Rows.Count).End(xlUp).RowEnd Sub Ce qui m'affiche le contenu de la colonne G (a partir de la ligne 5), cela représente le numéro de mes fiches Ensuite pour l'execution de la macro j'utilise ce code( avec barre de progression, mais ce n'est pas le problème pour le moment) : Private Sub Cmd_PDF_Click() Dim i As Byte Dim nbToGo As Integer Dim Progression As Integer ' Nombre d'elements dans la liste nbToGo = ListBox1.ListCount Dim prc As Integer Application.ScreenUpdating = False creer_fiches.Height = 225.75 'boucle sur les éléments de la ListBox image_barre.Width = 1 Progression = 0 For i = 0 To nbToGo - 1 Progression = Progression + 1 prc = Int(Progression / nbToGo * 100) Debug.Print "Progression:" & Progression & " nbToGo:" & nbToGo & " prc = " & prc image_barre.Width = Int((Progression / nbToGo) * 100) * 2.33 Label_barre.Caption = Int((Progression / nbToGo) * 100) & "%" If ListBox1.Selected(i) = True Then 'listanfm = ListBox1.List(i) 'numéro de la fiche 'Sheets(listanfm).Select DoEvents 'On lance la création des fiches creer_fiches2 End If Next Application.ScreenUpdating = True creer_fiches.Height = 249.75 End Sub et le module qui est appelé est celui-ci : Sub creer_fiches2() Dim bdd As Workbook, Fvierge As Workbook Dim rep As String Dim Classeurpath As String Dim Classeurphoto As String Dim accessibilite, inaccessibilite, accespart, accescom, faiencage, ecaillage, cloqgonf, eclatbeton, betonautre As String Dim niveau, atelier, SALLE1, SALLE2, betoncom, traversante, nontraversante, noncaracterisable, infiltrante, enreseau As String Dim sup1mm, inf1mm, emax, emaxsalle2, corrosion, pasdacier, acierapparent, naturelle, rougeatre, blanchatre As String Dim trace, pastrace, coulure, humidite, seche, efflorescence, aureole As String Dim nfiche, nb, chemin, salle1_3R, salle1_zone4, salle1_feu, salle1_ext, salle1_123 As String Dim salle2_3R, salle2_zone4, salle2_feu, salle2_ext, salle2_123, murN, murO, murS, murE, PLANCHER As String Dim RADIER, PLAFOND, POTEAU, POUTRE, INTERIEUR, remarques As String 'chemin = Sheets("BDD").Range("AZV1").Value (en prévision, ne sert a rien pour le moment) nb = Sheets("BDD").Range("AZT1").Value 'i est le nombre de fissures, la ligne de départ est 5, le nombre de fissures est n 'ligne_fin = 5 + nb - 1 ligne_fin = Cells.Find("*", Range("B1"), , , xlByRows, xlPrevious).Row rep = Environ("USERPROFILE") & "\" Classeurpath = rep & "Documents\HagueInspection\Fiches\Fvierge.xlsm" Classeurphoto = rep & "Documents\HagueInspection\Photos\RIMG" 'RIMG représente le préfixe de la photo 'Il peut être changer en fonction de l'appareil Set bdd = ThisWorkbook Set Fvierge = Workbooks.Open(Classeurpath) 'With Fvierge.Worksheets("Fvierge") For i = 5 To ligne_fin 'ici j'écris le code qui remet toutes les valeurs de BDD vers le Rapport 'nfiche = bdd.Worksheets("BDD").Range("G" & i) With Fvierge.Worksheets("Fvierge") On Error Resume Next .Name = bdd.Worksheets("BDD").Range("G" & i) atelier = bdd.Worksheets("BDD").Range("C" & i).Value niveau = bdd.Worksheets("BDD").Range("D" & i).Value SALLE1 = bdd.Worksheets("BDD").Range("E" & i).Value SALLE2 = bdd.Worksheets("BDD").Range("F" & i).Value accessibilite = bdd.Worksheets("BDD").Range("Q" & i).Value inaccessibilite = bdd.Worksheets("BDD").Range("R" & i).Value accespart = bdd.Worksheets("BDD").Range("S" & i).Value accescom = bdd.Worksheets("BDD").Range("T" & i).Value faiencage = bdd.Worksheets("BDD").Range("U" & i).Value ecaillage = bdd.Worksheets("BDD").Range("V" & i).Value cloqgonf = bdd.Worksheets("BDD").Range("W" & i).Value eclatbeton = bdd.Worksheets("BDD").Range("X" & i).Value betonautre = bdd.Worksheets("BDD").Range("Y" & i).Value betoncom = bdd.Worksheets("BDD").Range("Z" & i).Value nontraversante = bdd.Worksheets("BDD").Range("AA" & i).Value traversante = bdd.Worksheets("BDD").Range("AB" & i).Value noncaracterisable = bdd.Worksheets("BDD").Range("AC" & i).Value infiltrante = bdd.Worksheets("BDD").Range("AD" & i).Value enreseau = bdd.Worksheets("BDD").Range("AE" & i).Value emax = bdd.Worksheets("BDD").Range("AF" & i).Value emaxsalle2 = bdd.Worksheets("BDD").Range("AG" & i).Value inf1mm = bdd.Worksheets("BDD").Range("AH" & i).Value sup1mm = bdd.Worksheets("BDD").Range("AI" & i).Value corrosion = bdd.Worksheets("BDD").Range("AJ" & i).Value pasdacier = bdd.Worksheets("BDD").Range("AK" & i).Value acierapparent = bdd.Worksheets("BDD").Range("AL" & i).Value naturelle = bdd.Worksheets("BDD").Range("AM" & i).Value rougeatre = bdd.Worksheets("BDD").Range("AN" & i).Value blanchatre = bdd.Worksheets("BDD").Range("AO" & i).Value pastrace = bdd.Worksheets("BDD").Range("AP" & i).Value trace = bdd.Worksheets("BDD").Range("AQ" & i).Value coulure = bdd.Worksheets("BDD").Range("AR" & i).Value humidite = bdd.Worksheets("BDD").Range("AS" & i).Value seche = bdd.Worksheets("BDD").Range("AT" & i).Value efflorescence = bdd.Worksheets("BDD").Range("AU" & i).Value aureole = bdd.Worksheets("BDD").Range("AV" & i).Value salle1_3R = bdd.Worksheets("BDD").Range("AW" & i).Value salle1_zone4 = bdd.Worksheets("BDD").Range("AX" & i).Value salle1_feu = bdd.Worksheets("BDD").Range("AY" & i).Value salle1_ext = bdd.Worksheets("BDD").Range("AZ" & i).Value salle1_123 = bdd.Worksheets("BDD").Range("BA" & i).Value salle2_3R = bdd.Worksheets("BDD").Range("BB" & i).Value salle2_zone4 = bdd.Worksheets("BDD").Range("BC" & i).Value salle2_feu = bdd.Worksheets("BDD").Range("BD" & i).Value salle2_ext = bdd.Worksheets("BDD").Range("BE" & i).Value salle2_123 = bdd.Worksheets("BDD").Range("BF" & i).Value murN = bdd.Worksheets("BDD").Range("H" & i).Value murS = bdd.Worksheets("BDD").Range("I" & i).Value murO = bdd.Worksheets("BDD").Range("J" & i).Value murE = bdd.Worksheets("BDD").Range("K" & i).Value PLANCHER = bdd.Worksheets("BDD").Range("L" & i).Value RADIER = bdd.Worksheets("BDD").Range("M" & i).Value PLAFOND = bdd.Worksheets("BDD").Range("N" & i).Value POUTRE = bdd.Worksheets("BDD").Range("O" & i).Value POTEAU = bdd.Worksheets("BDD").Range("P" & i).Value remarques = bdd.Worksheets("BDD").Range("BG" & i).Value Sheets(nfiche).Range("F6") = nfiche Sheets(nfiche).Range("E8") = atelier Sheets(nfiche).Range("P8") = niveau Sheets(nfiche).Range("E9") = SALLE1 Sheets(nfiche).Range("E10") = SALLE2 Sheets(nfiche).Range("G16") = accessibilite Sheets(nfiche).Range("J16") = inaccessibilite Sheets(nfiche).Range("O16") = accespart Sheets(nfiche).Range("S16") = accescom Sheets(nfiche).Range("G26") = faiencage Sheets(nfiche).Range("G28") = ecaillage Sheets(nfiche).Range("G30") = cloqgonf Sheets(nfiche).Range("J26") = eclatbeton Sheets(nfiche).Range("J28") = betonautre Sheets(nfiche).Range("K30") = betoncom Sheets(nfiche).Range("G38") = nontraversante Sheets(nfiche).Range("G40") = traversante Sheets(nfiche).Range("G42") = noncaracterisable Sheets(nfiche).Range("J38") = infiltrante Sheets(nfiche).Range("J40") = enreseau Sheets(nfiche).Range("P40") = emax Sheets(nfiche).Range("P42") = emaxsalle2 Sheets(nfiche).Range("J42") = inf1mm Sheets(nfiche).Range("O38") = sup1mm Sheets(nfiche).Range("Z26") = corrosion Sheets(nfiche).Range("Z28") = pasdacier Sheets(nfiche).Range("Z30") = acierapparent Sheets(nfiche).Range("G50") = naturelle Sheets(nfiche).Range("G52") = rougeatre Sheets(nfiche).Range("G54") = blanchatre Sheets(nfiche).Range("O50") = pastrace Sheets(nfiche).Range("O53") = trace Sheets(nfiche).Range("V50") = coulure Sheets(nfiche).Range("V52") = humidite Sheets(nfiche).Range("V54") = seche Sheets(nfiche).Range("Z50") = efflorescence Sheets(nfiche).Range("Z52") = aureole Sheets(nfiche).Range("D62") = salle1_3R Sheets(nfiche).Range("G62") = salle1_zone4 Sheets(nfiche).Range("J62") = salle1_feu Sheets(nfiche).Range("O62") = salle1_ext Sheets(nfiche).Range("R62") = salle1_123 Sheets(nfiche).Range("D67") = salle2_3R Sheets(nfiche).Range("G67") = salle2_zone4 Sheets(nfiche).Range("J67") = salle2_feu Sheets(nfiche).Range("O67") = salle2_ext Sheets(nfiche).Range("R67") = salle2_123 Sheets(nfiche).Range("D102") = murN Sheets(nfiche).Range("G102") = murS Sheets(nfiche).Range("J102") = murO Sheets(nfiche).Range("O102") = murE Sheets(nfiche).Range("D104") = PLANCHER Sheets(nfiche).Range("G104") = RADIER Sheets(nfiche).Range("J104") = PLAFOND Sheets(nfiche).Range("O104") = POUTRE Sheets(nfiche).Range("R104") = POTEAU Sheets(nfiche).Range("C71") = remarques 'Et le code qui mettra les photos au bon endroit photo1 = Classeurphoto & Format(bdd.Worksheets("BDD").Range("BH" & i).Value, "0000") & ".jpg" If Dir(photo1) <> "" Then Sheets(nfiche).Image1.Picture = LoadPicture(photo1) End If photo2 = Classeurphoto & Format(bdd.Worksheets("BDD").Range("BI" & i).Value, "0000") & ".jpg" If Dir(photo2) <> "" Then Sheets(nfiche).Image1.Picture = LoadPicture(photo2) End If photo3 = Classeurphoto & Format(bdd.Worksheets("BDD").Range("BJ" & i).Value, "0000") & ".jpg" If Dir(photo3) <> "" Then Sheets(nfiche).Image1.Picture = LoadPicture(photo3) End If copie_feuille Cache_Fvierge End With Next i End Sub Et biensure ça ne fonctionne pas car l'indice n'appartient pas à la sélection... JE ne suis pas un grand spécialiste du VBA et j'apprend (j'ai récupérer certain bout de code que j'ai tenté d'adapter... Merci pour ton aide

Créer fiche en fonction d'une listbox

2 réponses

Votre réponse

Discussions similaires