Problème avec une macro

Bonjour à tous

Donc voilà, je me retrouve face à une nouvelle aventure, qui je pense sera simple pour vous, je vous explique

J'ai un classeur "BDD", sur ce classeur, chaque ligne correspond à une rapport, ce même classeur contiens 1402 lignes.

J'ai un USF qui au lancement m'affiche dans une listbox le contenu d'une colonne , elle est en multiselect, j'ai un second classeur qui est la trame des rapports a créer.

Je souhaite que lorsque je selectionne dans ma listbox certaine fiches, il me fasse uniquement celle que j'ai selectionné, mais avec mon code il me fait tout le tableau malgré ma sélection.

Voici les codes :

MACRO DE LA LISTBOX

Private Sub Cmd_fiche_Click()
 Dim i As Integer
    Dim nbToGo As Integer

    ' Nombre d'elements dans la liste
    nbToGo = ListBox1.ListCount
    'boucle sur les éléments de la ListBox
        For i = 0 To nbToGo - 1
            If ListBox1.Selected(i) = True Then
                'numerofiche = ListBox1.List(i) 'numéro de la fiche
            'Sheets(numerofiche).Select
                DoEvents
                'On lance la création des fiches
                    Creer_rapports
            End If
        Next

End Sub

SUB DU RAPPORT

Sub Creer_rapports()
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 repmat As String, site As String, theme As String, oin As String, fiche As String, typeanc As String, loc As String
Dim nbreel As String, plan As String, diametrereel As String, tr As String, syst As String, nmat As String, bigramme As String, contcom As String
Dim log As String, vol As String, ddd As String, typeouti As String, numoutil As String, limval As String
Dim contnomenvisible As String, diamexistant As String, nbexistant As String, absanomalie As String, presenceconforme As String
Dim liaison As String, conclusionmontage As String, absencedecol As String, dimdecol As String, abstracedepplatine As String
Dim dimampdirsens As String, absfissure As String, ouvfissure As String, absepauf As String, profepauf As String
Dim gcconforme As String, presencerevet As String, naturrevet As String, abscorrogen As String, abscorropiq As String
Dim abspertmatiere As String, etatcorroaccept As String, numconstat As String, numphoto1 As String, numphoto2 As String
Dim piecerempllot1 As String, piecerempllot2 As String, piecerempllot3 As String, descriptconstasol As String
Dim controdem As String, coupltest As String, scelconflog As String, verifscelpos As String, numecart As String

    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)

        With rapex.Worksheets("RE_Type_Cheville")
            For i = 4 To ligne_fin
                nrapex = CStr(bdd.Worksheets("BDD").Range("J" & i))
                rapex.Worksheets("RE_Type_Cheville").Copy Before:=rapex.Worksheets("RE_Type_Cheville")
                ActiveSheet.Name = nrapex

    ' Renseignement sur l'inspection

        site = bdd.Worksheets("BDD").Range("A" & i).Value                   ' Valeur de la variable site
        theme = bdd.Worksheets("BDD").Range("B" & i).Value                  ' Valeur de la variable theme du controle
        oin = bdd.Worksheets("BDD").Range("C" & i).Value                    ' Valeur de la variable N° d'OIN
        fiche = bdd.Worksheets("BDD").Range("J" & i).Value                  ' Valeur de la variable N° de la fiche
        repmat = bdd.Worksheets("BDD").Range("D" & i).Value                 ' Valeur de la variable de repere materiel
        typeanc = bdd.Worksheets("BDD").Range("Q" & i).Value                ' Valeur de la variable type d'ancrage
        loc = bdd.Worksheets("BDD").Range("I" & i).Value                    ' Valeur de la variable local
        nbreel = bdd.Worksheets("BDD").Range("S" & i).Value                 ' Valeur de la variable nombre d'ancrage réel
        diametrereel = bdd.Worksheets("BDD").Range("T" & i).Value           ' Valeur de la variable diamètre réel de l'ancrage
        plan = bdd.Worksheets("BDD").Range("U" & i).Value                   ' Valeur de la variable N° de plan
        tr = bdd.Worksheets("BDD").Range("E" & i).Value                     ' Valeur de la variable tranche
        syst = bdd.Worksheets("BDD").Range("F" & i).Value                   ' Valeur de la variable système
        nmat = bdd.Worksheets("BDD").Range("G" & i).Value                   ' Valeur de la variable numéro de matériel
        bigramme = bdd.Worksheets("BDD").Range("H" & i).Value               ' Valeur de la variable bigramme
        contcom = bdd.Worksheets("BDD").Range("R" & i).Value                ' Valeur de la variable controle commun GC
        typeouti = bdd.Worksheets("BDD").Range("K" & i).Value               ' Valeur de la variable type d'outillage
        numoutil = bdd.Worksheets("BDD").Range("L" & i).Value               ' Valeur de la variable numéro de l'outillage
        limval = bdd.Worksheets("BDD").Range("M" & i).Value                 ' Valeur de la variable limite de valité
        contnomenvisible = bdd.Worksheets("BDD").Range("V" & i).Value       ' Valeur de la variable présence de tous les constituants visible
        diamexistant = bdd.Worksheets("BDD").Range("T" & i).Value           ' Valeur de la variable du diamètre relevé
        nbexistant = bdd.Worksheets("BDD").Range("S" & i).Value             ' Valeur de la variable du nombre de chevilles existante
        absanomalie = bdd.Worksheets("BDD").Range("Y" & i).Value            ' Valeur de la variable de l'absence d'anomalies
        presenceconforme = bdd.Worksheets("BDD").Range("Z" & i).Value       ' Valeur de la variable de la présence des ancrage conforme
        liaison = bdd.Worksheets("BDD").Range("AA" & i).Value               ' Valeur de la variable du jeu des liaisons fileté conforme
        conclusionmontage = bdd.Worksheets("BDD").Range("AB" & i).Value     ' Valeur de la variable de conclusion montage conforme
        absencedecol = bdd.Worksheets("BDD").Range("AC" & i).Value          ' Valeur de la variable de l'absence de décolement de la platine du GC
        dimdecol = bdd.Worksheets("BDD").Range("AD" & i).Value              ' Valeur de la variable des dimensions du decollement
        abstracedepplatine = bdd.Worksheets("BDD").Range("AE" & i).Value
        dimampdirsens = bdd.Worksheets("BDD").Range("AF" & i).Value
        absfissure = bdd.Worksheets("BDD").Range("AG" & i).Value
        ouvfissure = bdd.Worksheets("BDD").Range("AH" & i).Value
        absepauf = bdd.Worksheets("BDD").Range("AI" & i).Value
        profepauf = bdd.Worksheets("BDD").Range("AJ" & i).Value
        gcconforme = bdd.Worksheets("BDD").Range("AK" & i).Value
        presencerevet = bdd.Worksheets("BDD").Range("AL" & i).Value
        naturrevet = bdd.Worksheets("BDD").Range("AM" & i).Value
        abscorrogen = bdd.Worksheets("BDD").Range("AN" & i).Value
        abscorropiq = bdd.Worksheets("BDD").Range("AO" & i).Value
        abspertmatiere = bdd.Worksheets("BDD").Range("AP" & i).Value
        etatcorroaccept = bdd.Worksheets("BDD").Range("AQ" & i).Value
        controdem = bdd.Worksheets("BDD").Range("AR" & i).Value
        coupltest = bdd.Worksheets("BDD").Range("AS" & i).Value
        scelconflog = bdd.Worksheets("BDD").Range("AT" & i).Value
        verifscelpos = bdd.Worksheets("BDD").Range("AU" & i).Value
        numconstat = bdd.Worksheets("BDD").Range("AV" & i).Value
        numécart = bdd.Worksheets("BDD").Range("AW" & i).Value
        numphoto1 = bdd.Worksheets("BDD").Range("AX" & i).Value
        numphoto2 = bdd.Worksheets("BDD").Range("AY" & i).Value
        piecerempllot1 = bdd.Worksheets("BDD").Range("AZ" & i).Value
        piecerempllot2 = bdd.Worksheets("BDD").Range("BA" & i).Value
        piecerempllot3 = bdd.Worksheets("BDD").Range("BB" & i).Value
        descriptconstasol = bdd.Worksheets("BDD").Range("BB" & i).Value

    ' On écrit les valeurs dans le rapport

        Sheets(nrapex).Range("AE13") = site
        Sheets(nrapex).Range("A13") = oin
        Sheets(nrapex).Range("K13") = repmat
        Sheets(nrapex).Range("S14") = loc

                Select Case theme
                        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

        Sheets(nrapex).Range("A26") = typeouti
        Sheets(nrapex).Range("Q26") = numoutil
        Sheets(nrapex).Range("AI26") = limval
        Sheets(nrapex).Range("AN70") = fiche

                Select Case contcom
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN73").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS73").Value = "X"
                End Select

        Sheets(nrapex).Range("AI75") = nbreel
        Sheets(nrapex).Range("AI76") = diametrereel
        Sheets(nrapex).Range("AI77") = plan

                Select Case contnomenvisible
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN79").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS79").Value = "X"
                End Select

        Sheets(nrapex).Range("AI81") = diamexistant
        Sheets(nrapex).Range("AI82") = nbexistant

                Select Case absanomalie
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN84").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS84").Value = "X"
                End Select

                Select Case presenceconforme
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN87").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS87").Value = "X"
                End Select

                Select Case liaison
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN90").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS90").Value = "X"
                End Select

        Sheets(nrapex).Range("AI92") = conclusionmontage

             ' Etat du génie civile au voisinage des ancrages

                Select Case absencedecol
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN95").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS95").Value = "X"
                End Select

        Sheets(nrapex).Range("AM97") = dimdecol

                Select Case abstracedepplatine
                        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 absfissure
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN105").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS105").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = ouvfissure

                Select Case absepauf
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN110").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS110").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = profepauf

                Select Case gcconforme
                        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 presencerevet
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN119").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS119").Value = "X"
                End Select

        Sheets(nrapex).Range("AI121") = naturrevet

                Select Case abscorrogen
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN123").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS123").Value = "X"
                End Select

                Select Case abscorropiq
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN126").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS126").Value = "X"
                End Select

                Select Case abspertmatiere
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN1129").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS129").Value = "X"
                End Select

                Select Case etatcorroaccept
                        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 controdem
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN136").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS136").Value = "X"
                End Select

        Sheets(nrapex).Range("AI138") = coupltest

                Select Case scelconflog
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN140").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS140").Value = "X"
                End Select

                Select Case verifscelpos
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN143").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS143").Value = "X"
                End Select

            Next i
        End With

End Sub

Voilà, en espérant avoir été explicite,

Merci à tous

chris

Bonjour,

Je ne vois aucune interaction entre tes deux codes ?! Tu devrais avoir une variable publique quelque part qui devrait être initialisée lors de la boucle dans la ComboBox puis utilisée dans le second code. Je n'ai rien vu de tout cela. Mais bon, Faut dire que ton second code est tellement long...

Salut Theautheme,

Merci de t'être penché sur mon soucis, mais je suis justement dessus et il y a une erreur grosse comme le monde, en clair, dans la macro de la listbox, je boucle sur la colonne "D" mais la sub que j'appelle ensuite boucle elle sur le tableau complet...

Donc je vais modifier tout ça et je reviendrais avec un vrai problème...

Merci quand même

PS : mon code est long je sais mais je suis novice, je suis encore dans le ça marche c'est bon.. le pro viendra après

Bye

Chris

Re,

Oui c'est bien ce qu'il me semblait... Tu devrais déclarer une variable Publique (pour pouvoir l'utiliser dans tous le projet VBA) en haut d'un module standard (par exemple) :

Public LI as Integer

Puis dans le code de la ComboBox :

Private Sub Cmd_fiche_Click()
Dim i As Integer
Dim nbToGo As Integer

nbToGo = ListBox1.ListCount
For i = 0 To nbToGo - 1
    If ListBox1.Selected(i) = True Then
        LI = i 'à adapter
        DoEvents
        Creer_rapports
    End If
Next i
End Sub

et enfin dans la sub, rajouter à la boucle :

For i = 4 To ligne_fin
    If i = LI Then
        '... ton code (très bien écrit au passage)
    End If
Next i
LI = 0

Re,

Alors moi j'ai réécrit mon code (en moin pro certe) il fonctionne, sauf qu'il m'en oublie et de plus en met que je n'est pas selectionné, je te laisse voir.. mais je vais tenter ta méthode.

Private Sub Cmd_PDF_Click()
Dim i As Integer, nbToGo As Integer
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 repmat As String, site As String, theme As String, oin As String, fiche As String, typeanc As String, loc As String
Dim nbreel As String, plan As String, diametrereel As String, tr As String, syst As String, nmat As String, bigramme As String, contcom As String
Dim log As String, vol As String, ddd As String, typeouti As String, numoutil As String, limval As String
Dim contnomenvisible As String, diamexistant As String, nbexistant As String, absanomalie As String, presenceconforme As String
Dim liaison As String, conclusionmontage As String, absencedecol As String, dimdecol As String, abstracedepplatine As String
Dim dimampdirsens As String, absfissure As String, ouvfissure As String, absepauf As String, profepauf As String
Dim gcconforme As String, presencerevet As String, naturrevet As String, abscorrogen As String, abscorropiq As String
Dim abspertmatiere As String, etatcorroaccept As String, numconstat As String, numphoto1 As String, numphoto2 As String
Dim piecerempllot1 As String, piecerempllot2 As String, piecerempllot3 As String, descriptconstasol As String
Dim controdem As String, coupltest As String, scelconflog As String, verifscelpos As String, numecart As String

    rep = Environ("USERPROFILE") & "\"
    classeurpath = rep & "Documents\InspectionAncrages\Rapports_expertise\rap_exp_chevilles.xlsm"
    classeurphoto = rep & "Documents\InspectionAncrages\Photos"
    classeurplan = rep & " Documents\InspectionAncrages\Plans"
    nbToGo = ListBox1.ListCount

Set bdd = ThisWorkbook
Set rapex = Workbooks.Open(classeurpath)

    'boucle sur les éléments de la ListBox
        For i = 0 To nbToGo - 1
            If ListBox1.Selected(i) = True Then
               nrapex = CStr(bdd.Worksheets("BDD").Range("J" & i))
                rapex.Worksheets("RE_Type_Cheville").Copy Before:=rapex.Worksheets("RE_Type_Cheville")
                ActiveSheet.Name = nrapex

        site = bdd.Worksheets("BDD").Range("A" & i).Value                   ' Valeur de la variable site
        theme = bdd.Worksheets("BDD").Range("B" & i).Value                  ' Valeur de la variable theme du controle
        oin = bdd.Worksheets("BDD").Range("C" & i).Value                    ' Valeur de la variable N° d'OIN
        fiche = bdd.Worksheets("BDD").Range("J" & i).Value                  ' Valeur de la variable N° de la fiche
        repmat = bdd.Worksheets("BDD").Range("D" & i).Value                 ' Valeur de la variable de repere materiel
        typeanc = bdd.Worksheets("BDD").Range("Q" & i).Value                ' Valeur de la variable type d'ancrage
        loc = bdd.Worksheets("BDD").Range("I" & i).Value                    ' Valeur de la variable local
        nbreel = bdd.Worksheets("BDD").Range("S" & i).Value                 ' Valeur de la variable nombre d'ancrage réel
        diametrereel = bdd.Worksheets("BDD").Range("T" & i).Value           ' Valeur de la variable diamètre réel de l'ancrage
        plan = bdd.Worksheets("BDD").Range("U" & i).Value                   ' Valeur de la variable N° de plan
        tr = bdd.Worksheets("BDD").Range("E" & i).Value                     ' Valeur de la variable tranche
        syst = bdd.Worksheets("BDD").Range("F" & i).Value                   ' Valeur de la variable système
        nmat = bdd.Worksheets("BDD").Range("G" & i).Value                   ' Valeur de la variable numéro de matériel
        bigramme = bdd.Worksheets("BDD").Range("H" & i).Value               ' Valeur de la variable bigramme
        contcom = bdd.Worksheets("BDD").Range("R" & i).Value                ' Valeur de la variable controle commun GC
        typeouti = bdd.Worksheets("BDD").Range("K" & i).Value               ' Valeur de la variable type d'outillage
        numoutil = bdd.Worksheets("BDD").Range("L" & i).Value               ' Valeur de la variable numéro de l'outillage
        limval = bdd.Worksheets("BDD").Range("M" & i).Value                 ' Valeur de la variable limite de valité
        contnomenvisible = bdd.Worksheets("BDD").Range("V" & i).Value       ' Valeur de la variable présence de tous les constituants visible
        diamexistant = bdd.Worksheets("BDD").Range("T" & i).Value           ' Valeur de la variable du diamètre relevé
        nbexistant = bdd.Worksheets("BDD").Range("S" & i).Value             ' Valeur de la variable du nombre de chevilles existante
        absanomalie = bdd.Worksheets("BDD").Range("Y" & i).Value            ' Valeur de la variable de l'absence d'anomalies
        presenceconforme = bdd.Worksheets("BDD").Range("Z" & i).Value       ' Valeur de la variable de la présence des ancrage conforme
        liaison = bdd.Worksheets("BDD").Range("AA" & i).Value               ' Valeur de la variable du jeu des liaisons fileté conforme
        conclusionmontage = bdd.Worksheets("BDD").Range("AB" & i).Value     ' Valeur de la variable de conclusion montage conforme
        absencedecol = bdd.Worksheets("BDD").Range("AC" & i).Value          ' Valeur de la variable de l'absence de décolement de la platine du GC
        dimdecol = bdd.Worksheets("BDD").Range("AD" & i).Value              ' Valeur de la variable des dimensions du decollement
        abstracedepplatine = bdd.Worksheets("BDD").Range("AE" & i).Value
        dimampdirsens = bdd.Worksheets("BDD").Range("AF" & i).Value
        absfissure = bdd.Worksheets("BDD").Range("AG" & i).Value
        ouvfissure = bdd.Worksheets("BDD").Range("AH" & i).Value
        absepauf = bdd.Worksheets("BDD").Range("AI" & i).Value
        profepauf = bdd.Worksheets("BDD").Range("AJ" & i).Value
        gcconforme = bdd.Worksheets("BDD").Range("AK" & i).Value
        presencerevet = bdd.Worksheets("BDD").Range("AL" & i).Value
        naturrevet = bdd.Worksheets("BDD").Range("AM" & i).Value
        abscorrogen = bdd.Worksheets("BDD").Range("AN" & i).Value
        abscorropiq = bdd.Worksheets("BDD").Range("AO" & i).Value
        abspertmatiere = bdd.Worksheets("BDD").Range("AP" & i).Value
        etatcorroaccept = bdd.Worksheets("BDD").Range("AQ" & i).Value
        controdem = bdd.Worksheets("BDD").Range("AR" & i).Value
        coupltest = bdd.Worksheets("BDD").Range("AS" & i).Value
        scelconflog = bdd.Worksheets("BDD").Range("AT" & i).Value
        verifscelpos = bdd.Worksheets("BDD").Range("AU" & i).Value
        numconstat = bdd.Worksheets("BDD").Range("AV" & i).Value
        numécart = bdd.Worksheets("BDD").Range("AW" & i).Value
        numphoto1 = bdd.Worksheets("BDD").Range("AX" & i).Value
        numphoto2 = bdd.Worksheets("BDD").Range("AY" & i).Value
        piecerempllot1 = bdd.Worksheets("BDD").Range("AZ" & i).Value
        piecerempllot2 = bdd.Worksheets("BDD").Range("BA" & i).Value
        piecerempllot3 = bdd.Worksheets("BDD").Range("BB" & i).Value
        descriptconstasol = bdd.Worksheets("BDD").Range("BB" & i).Value

    ' On écrit les valeurs dans le rapport

        Sheets(nrapex).Range("AE13") = site
        Sheets(nrapex).Range("A13") = oin
        Sheets(nrapex).Range("K13") = repmat
        Sheets(nrapex).Range("S14") = loc

                Select Case theme
                        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

        Sheets(nrapex).Range("A26") = typeouti
        Sheets(nrapex).Range("Q26") = numoutil
        Sheets(nrapex).Range("AI26") = limval
        Sheets(nrapex).Range("AN70") = fiche

                Select Case contcom
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN73").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS73").Value = "X"
                End Select

        Sheets(nrapex).Range("AI75") = nbreel
        Sheets(nrapex).Range("AI76") = diametrereel
        Sheets(nrapex).Range("AI77") = plan

                Select Case contnomenvisible
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN79").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS79").Value = "X"
                End Select

        Sheets(nrapex).Range("AI81") = diamexistant
        Sheets(nrapex).Range("AI82") = nbexistant

                Select Case absanomalie
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN84").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS84").Value = "X"
                End Select

                Select Case presenceconforme
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN87").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS87").Value = "X"
                End Select

                Select Case liaison
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN90").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS90").Value = "X"
                End Select

        Sheets(nrapex).Range("AI92") = conclusionmontage

             ' Etat du génie civile au voisinage des ancrages

                Select Case absencedecol
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN95").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS95").Value = "X"
                End Select

        Sheets(nrapex).Range("AM97") = dimdecol

                Select Case abstracedepplatine
                        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 absfissure
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN105").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS105").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = ouvfissure

                Select Case absepauf
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN110").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS110").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = profepauf

                Select Case gcconforme
                        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 presencerevet
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN119").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS119").Value = "X"
                End Select

        Sheets(nrapex).Range("AI121") = naturrevet

                Select Case abscorrogen
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN123").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS123").Value = "X"
                End Select

                Select Case abscorropiq
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN126").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS126").Value = "X"
                End Select

                Select Case abspertmatiere
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN1129").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS129").Value = "X"
                End Select

                Select Case etatcorroaccept
                        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 controdem
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN136").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS136").Value = "X"
                End Select

        Sheets(nrapex).Range("AI138") = coupltest

                Select Case scelconflog
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN140").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS140").Value = "X"
                End Select

                Select Case verifscelpos
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN143").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS143").Value = "X"
                End Select

            End If
        Next i
End Sub

C'est le foutoir j'admet, mais comment raccourcir ce code

Merci encore

Chris

Re,

Donc je viens d'utiliser ta méthode, seulement j'ai un soucis, il veux me ré-ouvrir a chaque fois le fichier "rapex", voici le code :

Public LI As Integer

Private Sub CheckBox1_Click()
Dim i&
If CheckBox1 Then
    CheckBox1.Caption = "Tout désélectionner"
        For i = 0 To ListBox1.ListCount - 1
            ListBox1.Selected(i) = 1
        Next i
    Else
    CheckBox1.Caption = "Tout sélectionner"
        For i = 0 To ListBox1.ListCount - 1
            ListBox1.Selected(i) = 0
        Next i
End If
End Sub

Private Sub Cmd_PDF_Click()

Dim i As Integer
Dim nbToGo As Integer

nbToGo = ListBox1.ListCount
For i = 0 To nbToGo - 1
    If ListBox1.Selected(i) = True Then
        LI = i 'à adapter
       DoEvents
        Creer_rapports
    End If
Next i
End Sub

Sub Creer_rapports()
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 repmat As String, site As String, theme As String, oin As String, fiche As String, typeanc As String, loc As String
Dim nbreel As String, plan As String, diametrereel As String, tr As String, syst As String, nmat As String, bigramme As String, contcom As String
Dim log As String, vol As String, ddd As String, typeouti As String, numoutil As String, limval As String
Dim contnomenvisible As String, diamexistant As String, nbexistant As String, absanomalie As String, presenceconforme As String
Dim liaison As String, conclusionmontage As String, absencedecol As String, dimdecol As String, abstracedepplatine As String
Dim dimampdirsens As String, absfissure As String, ouvfissure As String, absepauf As String, profepauf As String
Dim gcconforme As String, presencerevet As String, naturrevet As String, abscorrogen As String, abscorropiq As String
Dim abspertmatiere As String, etatcorroaccept As String, numconstat As String, numphoto1 As String, numphoto2 As String
Dim piecerempllot1 As String, piecerempllot2 As String, piecerempllot3 As String, descriptconstasol As String
Dim controdem As String, coupltest As String, scelconflog As String, verifscelpos As String, numecart As String

    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)

            For i = 4 To ligne_fin
                If i = LI Then
                 With rapex.Worksheets("RE_Type_Cheville")
                    nrapex = CStr(bdd.Worksheets("BDD").Range("J" & i))
                    rapex.Worksheets("RE_Type_Cheville").Copy Before:=rapex.Worksheets("RE_Type_Cheville")
                    ActiveSheet.Name = nrapex

    ' Renseignement sur l'inspection

        site = bdd.Worksheets("BDD").Range("A" & i).Value                   ' Valeur de la variable site
        theme = bdd.Worksheets("BDD").Range("B" & i).Value                  ' Valeur de la variable theme du controle
        oin = bdd.Worksheets("BDD").Range("C" & i).Value                    ' Valeur de la variable N° d'OIN
        fiche = bdd.Worksheets("BDD").Range("J" & i).Value                  ' Valeur de la variable N° de la fiche
        repmat = bdd.Worksheets("BDD").Range("D" & i).Value                 ' Valeur de la variable de repere materiel
        typeanc = bdd.Worksheets("BDD").Range("Q" & i).Value                ' Valeur de la variable type d'ancrage
        loc = bdd.Worksheets("BDD").Range("I" & i).Value                    ' Valeur de la variable local
        nbreel = bdd.Worksheets("BDD").Range("S" & i).Value                 ' Valeur de la variable nombre d'ancrage réel
        diametrereel = bdd.Worksheets("BDD").Range("T" & i).Value           ' Valeur de la variable diamètre réel de l'ancrage
        plan = bdd.Worksheets("BDD").Range("U" & i).Value                   ' Valeur de la variable N° de plan
        tr = bdd.Worksheets("BDD").Range("E" & i).Value                     ' Valeur de la variable tranche
        syst = bdd.Worksheets("BDD").Range("F" & i).Value                   ' Valeur de la variable système
        nmat = bdd.Worksheets("BDD").Range("G" & i).Value                   ' Valeur de la variable numéro de matériel
        bigramme = bdd.Worksheets("BDD").Range("H" & i).Value               ' Valeur de la variable bigramme
        contcom = bdd.Worksheets("BDD").Range("R" & i).Value                ' Valeur de la variable controle commun GC
        typeouti = bdd.Worksheets("BDD").Range("K" & i).Value               ' Valeur de la variable type d'outillage
        numoutil = bdd.Worksheets("BDD").Range("L" & i).Value               ' Valeur de la variable numéro de l'outillage
        limval = bdd.Worksheets("BDD").Range("M" & i).Value                 ' Valeur de la variable limite de valité
        contnomenvisible = bdd.Worksheets("BDD").Range("V" & i).Value       ' Valeur de la variable présence de tous les constituants visible
        diamexistant = bdd.Worksheets("BDD").Range("T" & i).Value           ' Valeur de la variable du diamètre relevé
        nbexistant = bdd.Worksheets("BDD").Range("S" & i).Value             ' Valeur de la variable du nombre de chevilles existante
        absanomalie = bdd.Worksheets("BDD").Range("Y" & i).Value            ' Valeur de la variable de l'absence d'anomalies
        presenceconforme = bdd.Worksheets("BDD").Range("Z" & i).Value       ' Valeur de la variable de la présence des ancrage conforme
        liaison = bdd.Worksheets("BDD").Range("AA" & i).Value               ' Valeur de la variable du jeu des liaisons fileté conforme
        conclusionmontage = bdd.Worksheets("BDD").Range("AB" & i).Value     ' Valeur de la variable de conclusion montage conforme
        absencedecol = bdd.Worksheets("BDD").Range("AC" & i).Value          ' Valeur de la variable de l'absence de décolement de la platine du GC
        dimdecol = bdd.Worksheets("BDD").Range("AD" & i).Value              ' Valeur de la variable des dimensions du decollement
        abstracedepplatine = bdd.Worksheets("BDD").Range("AE" & i).Value
        dimampdirsens = bdd.Worksheets("BDD").Range("AF" & i).Value
        absfissure = bdd.Worksheets("BDD").Range("AG" & i).Value
        ouvfissure = bdd.Worksheets("BDD").Range("AH" & i).Value
        absepauf = bdd.Worksheets("BDD").Range("AI" & i).Value
        profepauf = bdd.Worksheets("BDD").Range("AJ" & i).Value
        gcconforme = bdd.Worksheets("BDD").Range("AK" & i).Value
        presencerevet = bdd.Worksheets("BDD").Range("AL" & i).Value
        naturrevet = bdd.Worksheets("BDD").Range("AM" & i).Value
        abscorrogen = bdd.Worksheets("BDD").Range("AN" & i).Value
        abscorropiq = bdd.Worksheets("BDD").Range("AO" & i).Value
        abspertmatiere = bdd.Worksheets("BDD").Range("AP" & i).Value
        etatcorroaccept = bdd.Worksheets("BDD").Range("AQ" & i).Value
        controdem = bdd.Worksheets("BDD").Range("AR" & i).Value
        coupltest = bdd.Worksheets("BDD").Range("AS" & i).Value
        scelconflog = bdd.Worksheets("BDD").Range("AT" & i).Value
        verifscelpos = bdd.Worksheets("BDD").Range("AU" & i).Value
        numconstat = bdd.Worksheets("BDD").Range("AV" & i).Value
        numécart = bdd.Worksheets("BDD").Range("AW" & i).Value
        numphoto1 = bdd.Worksheets("BDD").Range("AX" & i).Value
        numphoto2 = bdd.Worksheets("BDD").Range("AY" & i).Value
        piecerempllot1 = bdd.Worksheets("BDD").Range("AZ" & i).Value
        piecerempllot2 = bdd.Worksheets("BDD").Range("BA" & i).Value
        piecerempllot3 = bdd.Worksheets("BDD").Range("BB" & i).Value
        descriptconstasol = bdd.Worksheets("BDD").Range("BB" & i).Value

    ' On écrit les valeurs dans le rapport

        Sheets(nrapex).Range("AE13") = site
        Sheets(nrapex).Range("A13") = oin
        Sheets(nrapex).Range("K13") = repmat
        Sheets(nrapex).Range("S14") = loc

                Select Case theme
                        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

        Sheets(nrapex).Range("A26") = typeouti
        Sheets(nrapex).Range("Q26") = numoutil
        Sheets(nrapex).Range("AI26") = limval
        Sheets(nrapex).Range("AN70") = fiche

                Select Case contcom
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN73").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS73").Value = "X"
                End Select

        Sheets(nrapex).Range("AI75") = nbreel
        Sheets(nrapex).Range("AI76") = diametrereel
        Sheets(nrapex).Range("AI77") = plan

                Select Case contnomenvisible
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN79").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS79").Value = "X"
                End Select

        Sheets(nrapex).Range("AI81") = diamexistant
        Sheets(nrapex).Range("AI82") = nbexistant

                Select Case absanomalie
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN84").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS84").Value = "X"
                End Select

                Select Case presenceconforme
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN87").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS87").Value = "X"
                End Select

                Select Case liaison
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN90").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS90").Value = "X"
                End Select

        Sheets(nrapex).Range("AI92") = conclusionmontage

             ' Etat du génie civile au voisinage des ancrages

                Select Case absencedecol
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN95").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS95").Value = "X"
                End Select

        Sheets(nrapex).Range("AM97") = dimdecol

                Select Case abstracedepplatine
                        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 absfissure
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN105").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS105").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = ouvfissure

                Select Case absepauf
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN110").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS110").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = profepauf

                Select Case gcconforme
                        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 presencerevet
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN119").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS119").Value = "X"
                End Select

        Sheets(nrapex).Range("AI121") = naturrevet

                Select Case abscorrogen
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN123").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS123").Value = "X"
                End Select

                Select Case abscorropiq
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN126").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS126").Value = "X"
                End Select

                Select Case abspertmatiere
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN1129").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS129").Value = "X"
                End Select

                Select Case etatcorroaccept
                        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 controdem
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN136").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS136").Value = "X"
                End Select

        Sheets(nrapex).Range("AI138") = coupltest

                Select Case scelconflog
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN140").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS140").Value = "X"
                End Select

                Select Case verifscelpos
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN143").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS143").Value = "X"
                End Select

            End With
            End If
            Next i

LI = 0
End Sub

Merci a toi

Chris

Bonjour à tous,

Donc je suis encore avec mon problème en essayant de le resoudre par tous les moyens... mais c'est pas 100% opérationnel, je vous explique (à savoir que je ne peux malheureusement plus vous fournir le fichier en exemple)

Voici le code :

Private Sub Cmd_PDF_Click()
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 repmat As String, site As String, theme As String, oin As String, fiche As String, typeanc As String, loc As String
Dim nbreel As String, plan As String, diametrereel As String, tr As String, syst As String, nmat As String, bigramme As String, contcom As String
Dim log As String, vol As String, ddd As String, typeouti As String, numoutil As String, limval As String
Dim contnomenvisible As String, diamexistant As String, nbexistant As String, absanomalie As String, presenceconforme As String
Dim liaison As String, conclusionmontage As String, absencedecol As String, dimdecol As String, abstracedepplatine As String
Dim dimampdirsens As String, absfissure As String, ouvfissure As String, absepauf As String, profepauf As String
Dim gcconforme As String, presencerevet As String, naturrevet As String, abscorrogen As String, abscorropiq As String
Dim abspertmatiere As String, etatcorroaccept As String, numconstat As String, numphoto1 As String, numphoto2 As String
Dim piecerempllot1 As String, piecerempllot2 As String, piecerempllot3 As String, descriptconstasol As String
Dim controdem As String, coupltest As String, scelconflog As String, verifscelpos As String, numecart As String, refpbmp As String
Dim i As Integer
Dim nbToGo As Integer

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 - 1

For i = 0 To nbToGo
    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))
                    rapex.Worksheets("RE_Type_Cheville").Copy Before:=rapex.Worksheets("RE_Type_Cheville")
                    ActiveSheet.Name = nrapex
            ' Renseignement sur l'inspection

        site = bdd.Worksheets("BDD").Range("A" & i).Value                   ' Valeur de la variable site
        theme = bdd.Worksheets("BDD").Range("B" & i).Value                  ' Valeur de la variable theme du controle
        oin = bdd.Worksheets("BDD").Range("C" & i).Value                    ' Valeur de la variable N° d'OIN
        fiche = bdd.Worksheets("BDD").Range("J" & i).Value                  ' Valeur de la variable N° de la fiche
        repmat = bdd.Worksheets("BDD").Range("D" & i).Value                 ' Valeur de la variable de repere materiel
        typeanc = bdd.Worksheets("BDD").Range("Q" & i).Value                ' Valeur de la variable type d'ancrage
        loc = bdd.Worksheets("BDD").Range("I" & i).Value                    ' Valeur de la variable local
        nbreel = bdd.Worksheets("BDD").Range("S" & i).Value                 ' Valeur de la variable nombre d'ancrage réel
        diametrereel = bdd.Worksheets("BDD").Range("T" & i).Value           ' Valeur de la variable diamètre réel de l'ancrage
        plan = bdd.Worksheets("BDD").Range("U" & i).Value                   ' Valeur de la variable N° de plan
        tr = bdd.Worksheets("BDD").Range("E" & i).Value                     ' Valeur de la variable tranche
        syst = bdd.Worksheets("BDD").Range("F" & i).Value                   ' Valeur de la variable système
        nmat = bdd.Worksheets("BDD").Range("G" & i).Value                   ' Valeur de la variable numéro de matériel
        bigramme = bdd.Worksheets("BDD").Range("H" & i).Value               ' Valeur de la variable bigramme
        contcom = bdd.Worksheets("BDD").Range("R" & i).Value                ' Valeur de la variable controle commun GC
        typeouti = bdd.Worksheets("BDD").Range("K" & i).Value               ' Valeur de la variable type d'outillage
        numoutil = bdd.Worksheets("BDD").Range("L" & i).Value               ' Valeur de la variable numéro de l'outillage
        limval = bdd.Worksheets("BDD").Range("M" & i).Value                 ' Valeur de la variable limite de valité
        contnomenvisible = bdd.Worksheets("BDD").Range("V" & i).Value       ' Valeur de la variable présence de tous les constituants visible
        diamexistant = bdd.Worksheets("BDD").Range("T" & i).Value           ' Valeur de la variable du diamètre relevé
        nbexistant = bdd.Worksheets("BDD").Range("S" & i).Value             ' Valeur de la variable du nombre de chevilles existante
        absanomalie = bdd.Worksheets("BDD").Range("Y" & i).Value            ' Valeur de la variable de l'absence d'anomalies
        presenceconforme = bdd.Worksheets("BDD").Range("Z" & i).Value       ' Valeur de la variable de la présence des ancrage conforme
        liaison = bdd.Worksheets("BDD").Range("AA" & i).Value               ' Valeur de la variable du jeu des liaisons fileté conforme
        conclusionmontage = bdd.Worksheets("BDD").Range("AB" & i).Value     ' Valeur de la variable de conclusion montage conforme
        absencedecol = bdd.Worksheets("BDD").Range("AC" & i).Value          ' Valeur de la variable de l'absence de décolement de la platine du GC
        dimdecol = bdd.Worksheets("BDD").Range("AD" & i).Value              ' Valeur de la variable des dimensions du decollement
        abstracedepplatine = bdd.Worksheets("BDD").Range("AE" & i).Value
        dimampdirsens = bdd.Worksheets("BDD").Range("AF" & i).Value
        absfissure = bdd.Worksheets("BDD").Range("AG" & i).Value
        ouvfissure = bdd.Worksheets("BDD").Range("AH" & i).Value
        absepauf = bdd.Worksheets("BDD").Range("AI" & i).Value
        profepauf = bdd.Worksheets("BDD").Range("AJ" & i).Value
        gcconforme = bdd.Worksheets("BDD").Range("AK" & i).Value
        presencerevet = bdd.Worksheets("BDD").Range("AL" & i).Value
        naturrevet = bdd.Worksheets("BDD").Range("AM" & i).Value
        abscorrogen = bdd.Worksheets("BDD").Range("AN" & i).Value
        abscorropiq = bdd.Worksheets("BDD").Range("AO" & i).Value
        abspertmatiere = bdd.Worksheets("BDD").Range("AP" & i).Value
        etatcorroaccept = bdd.Worksheets("BDD").Range("AQ" & i).Value
        controdem = bdd.Worksheets("BDD").Range("AR" & i).Value
        coupltest = bdd.Worksheets("BDD").Range("AS" & i).Value
        scelconflog = bdd.Worksheets("BDD").Range("AT" & i).Value
        verifscelpos = bdd.Worksheets("BDD").Range("AU" & i).Value
        numconstat = bdd.Worksheets("BDD").Range("AV" & i).Value
        numécart = bdd.Worksheets("BDD").Range("AW" & i).Value
        numphoto1 = bdd.Worksheets("BDD").Range("AX" & i).Value
        numphoto2 = bdd.Worksheets("BDD").Range("AY" & i).Value
        piecerempllot1 = bdd.Worksheets("BDD").Range("AZ" & i).Value
        piecerempllot2 = bdd.Worksheets("BDD").Range("BA" & i).Value
        piecerempllot3 = bdd.Worksheets("BDD").Range("BB" & i).Value
        descriptconstasol = bdd.Worksheets("BDD").Range("BB" & i).Value
        refpbmp = bdd.Worksheets("BDD").Range("B" & i).Value

    ' On écrit les valeurs dans le rapport

        Sheets(nrapex).Range("AE13") = site
        Sheets(nrapex).Range("A13") = oin
        Sheets(nrapex).Range("K13") = repmat
        Sheets(nrapex).Range("S14") = loc

                Select Case theme
                        Case Is = "ECOT VD3"
                        Sheets(nrapex).Range("V16").Value = "X"
                        Case Is = Left("refpbmp", 4)
                        Sheets(nrapex).Range("AC16").Value = "X"
                        Sheets(nrapex).Range("AF16").Value = Right("refpbmp", 9)
                        Case Is = "AUTRE"
                        Sheets(nrapex).Range("AQ16").Value = "X"
                End Select

        Sheets(nrapex).Range("A26") = typeouti
        Sheets(nrapex).Range("Q26") = numoutil
        Sheets(nrapex).Range("AI26") = limval
        Sheets(nrapex).Range("AN70") = fiche

                Select Case contcom
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN73").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS73").Value = "X"
                End Select

        Sheets(nrapex).Range("AI75") = nbreel
        Sheets(nrapex).Range("AI76") = diametrereel
        Sheets(nrapex).Range("AI77") = plan

                Select Case contnomenvisible
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN79").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS79").Value = "X"
                End Select

        Sheets(nrapex).Range("AI81") = diamexistant
        Sheets(nrapex).Range("AI82") = nbexistant

                Select Case absanomalie
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN84").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS84").Value = "X"
                End Select

                Select Case presenceconforme
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN87").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS87").Value = "X"
                End Select

                Select Case liaison
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN90").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS90").Value = "X"
                End Select

        Sheets(nrapex).Range("AI92") = conclusionmontage

             ' Etat du génie civile au voisinage des ancrages

                Select Case absencedecol
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN95").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS95").Value = "X"
                End Select

        Sheets(nrapex).Range("AM97") = dimdecol

                Select Case abstracedepplatine
                        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 absfissure
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN105").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS105").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = ouvfissure

                Select Case absepauf
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN110").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS110").Value = "X"
                End Select

        Sheets(nrapex).Range("AM107") = profepauf

                Select Case gcconforme
                        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 presencerevet
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN119").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS119").Value = "X"
                End Select

        Sheets(nrapex).Range("AI121") = naturrevet

                Select Case abscorrogen
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN123").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS123").Value = "X"
                End Select

                Select Case abscorropiq
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN126").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS126").Value = "X"
                End Select

                Select Case abspertmatiere
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN1129").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS129").Value = "X"
                End Select

                Select Case etatcorroaccept
                        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 controdem
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN136").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS136").Value = "X"
                End Select

        Sheets(nrapex).Range("AI138") = coupltest

                Select Case scelconflog
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN140").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS140").Value = "X"
                End Select

                Select Case verifscelpos
                        Case Is = "OUI"
                        Sheets(nrapex).Range("AN143").Value = "X"
                        Case Is = "NON"
                        Sheets(nrapex).Range("AS143").Value = "X"
                End Select

            End With
            End If
            Next i

End Sub

Certe, il m'as été dit que je pouvais le raccourcir ce code... mais manque de compétence encore , bref...

Le résultat de ce code est que lorsque je sélectionne une fiche dans la listbox, et que je lance la création de la dite fiche, il ne me sort pas la bonne, c'est un peu pénible lol... je suis preneur de vos avis

Merci pour vos aides

Chris

Bonjour

cco86260 a écrit :

je suis preneur de vos avis

Joins ton fichier (anonymisé si besoin)

Salut Banzaï64

Je te poste le fichier mais c'est un zip, il faut le placer sur le bureau /User/Bureau/InspectionAncrages

Du coup ca plante maintenant, "erreur definie par l'application ou par l'objet"

Merci pour ton aide

Si tu rencontre des soucis fais moi signe

chris

Bonjour

Tu utilises la variable i pour récupérer les informations dans la feuille "BDD" il faut utiliser i + 4

Exemple

A la place de

nrapex = CStr(bdd.Worksheets("BDD").Range("J" & i))

il faut utiliser

nrapex = CStr(bdd.Worksheets("BDD").Range("J" & i + 4))

Ensuite pour la simplification tu pourrais éviter de passer par des variables, lorsque tu récupères les infos de la page "BDD"

Exemple

Tu utilises (code corrigé - i + 4)

site = bdd.Worksheets("BDD").Range("A" & i + 4).Value
        Sheets(nrapex).Range("AE13") = site

Tu peux faire

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

etc...

etc...

Re,

Merci banzaï64, ça fonctionne nickel, je pensais bien à une connerie du genre (vue que ma BDD démarre à la ligne 4)...

Passe un bon dimanche (enfin ...fin de)

A plus

Chris

Rechercher des sujets similaires à "probleme macro"