Créer fiche en fonction d'une listbox

Signaler
Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015
-
Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015
-
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

2 réponses

Messages postés
33473
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 septembre 2021
351
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




Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015

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).Row
End 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
Messages postés
33473
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 septembre 2021
351
Il semble également que dans ta seconde procédure tu instancie un nouveau classeur .. et donc lorsque tu reviens dans ta boucle... il ne trouve pas la feuille (puisque plus dans le même classeur...)

Tu peux éventuellement contourner le souci comme ça:

rivate Sub Cmd_PDF_Click()
 Dim i As Byte
    Dim nbToGo As Integer
    Dim Progression  As Integer
    Dim thisWkb as WorkBook
    
   Set thisWkb = ThisWorkBook
    ' 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
            thisWkb.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
Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015
>
Messages postés
33473
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 septembre 2021

Bonjour jordane45

Donc je me suis remis sur ce code et j'obtiens encore une erreur :

Variable objet ou variable de bloc with non définie

Voici le code écris :
Private Sub Cmd_PDF_Click()
 Dim i As Byte
    Dim nbToGo As Integer
    Dim Progression  As Integer
    Dim thisWkb As Workbook
    ' 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
   thisWkb.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 la ligne pointée est celle ci :

thisWkb.Sheets(listanfm).Select


Merci pour ton aide
Messages postés
33473
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 septembre 2021
351 >
Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015

En même temps... si tu n'arrives pas à copier coller exactement le code que je t'ai donné... ça risque de moins bien marcher....

Tu as oublié une ligne de code non???
   Set thisWkb = ThisWorkBook
Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015
>
Messages postés
33473
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 septembre 2021

Bonsoir jordane45,

Je n'ai pour une fois pas copir/coller car sinon je n'aurais pas fais cette enorme bourde... c'est une mauvaise lecture de ma part... ;)

Donc j'ai corrigé cet oublie, et maintenant cette même ligne est pointée et me dis que l'indice n'appartient pas à la sélection...

Je donne quelques précisions (car j'ai peur de mettre mal expliqué, et que de ce fait... on parte dans une mauvaise direction)...

Mon fichier BDD (là ou sont stocké mes défauts), contient plusieurs lignes qui sont numérotées de 1 à xxxx (ce sont les numéro de fiche ANFM), chaque lignes représentent donc 1 défaut donc 1 fiches. BDD est la seul feuille du classeur

Ce que je cherche à faire c'est lorsque je clique sur mon bouton "créer fiche", il m'ouvre une fenêtre, et dans la listbox il m'affiche les numero de fiche ANFM du classeur BDD et je sélectionne celle que je souhaite créer.

J'espère juste que c'est comme ça que ça avait été compris...

En tous les cas merci de ta patience.
Messages postés
51
Date d'inscription
jeudi 15 janvier 2015
Statut
Membre
Dernière intervention
2 mars 2015

Bonjour,

Je suis toujours en recherche de la solution a mon soucis, je n'arrive toujours pas à créer les fiches en fonction de leur sélection dans la listbox... si quelqu'un pourrais m'aider...

merci beaucoup