Bug lors de génération de PDF avec boucle

Le 21/02/2018 à 17:04

Bonjour à tous,

voici un code qui génère automatiquement plusieurs PDF à la suite si une condition est satisfaite.

Cela fonctionne très bien à la main, c'est à dire lorsque le premier Do-Loop est désactivé: l'incrémentation est bonne et tt est ok.

Sauf que lorsque je le fais en auto, un bug apparaît sur la génération du PDF:

Merci d'avance de votre aide.

Pierre

Sub SAUVEGARDE_CREATION_AUTO_FACTURES_CLIENTS()

Dim LaDate As String, LeParcours As String, LeRep As String, LeN°fac As String, chemin As String

Dim i As Variant

Dim ligne_volante As Variant

' ligne de la premiere cellule vide, c'est à dire non facturée

Dim ancre_volante As Variant

'valeur de concat année-mois-producteur qui est extrait de premiere cellule vide de BDD VENTES si concatannée mois est le bon

Dim max As Variant

'c'est la concat année_moi_producteur de référence et qui va prendre diff. valeurs en fonction du producteur

Dim n°facture_client_volant As Variant

' ds BDD VENTES le N° de facture client qui s'incrément

Dim NBVAL As Variant

Dim a_facturer As Variant

Dim c As Variant

Dim firstAddress As Variant

Dim j As Variant

Dim cible As Variant

Dim ba As Variant

Dim vide As Variant

Dim l As Variant

'1.ON CREE LE NUMERO DE FACTURE CLIENT DS BDD VENTES ET ON LE REPORT DANS FACTURE CLIENT papier

Sheets("BDD VENTES").Activate

NBVAL = Application.CountA(Range("v_Producteur"))

l = 1

'2.On cherche la première valeur à facturer et on extrait le nom du client:

'sera le filtre pr séparer les A FACTURER des autres clients

Do '

Sheets("BDD VENTES").Activate

Sheets("FACTURE CLIENT").Range("facclient_papier_N°").Value = Application.WorksheetFunction.max(Sheets("BDD VENTES").Range("bddventes_N°_facture_client").EntireColumn) + 1

n°facture_client_volant = Sheets("FACTURE CLIENT").Range("facclient_papier_N°").Value

With Worksheets("BDD VENTES").Range(Cells(l, Range("Eligibilite_à_la_facturation_en_cours").Column), Cells(Range("balise_bas").Row, Range("Eligibilite_à_la_facturation_en_cours").Column))

Set vide = .Find("A facturer", LookIn:=xlValues)

If Not vide Is Nothing Then

'firstAddress = ba.Address

l = vide.Row

'On extrait le nom du client et on le colle dans facture papier

Sheets("FACTURE CLIENT").Range("facclient_nom_du_client") = Cells(vide.Row, Range("v_Client").Column).Value

Else: MsgBox ("Pas de facture en attente")

Exit Sub

End If

End With

'If Cells(vide.Row, Range("Concat_année_mois_n°facture").Column).Value = Sheets("BDD FACTURES CLIENTS").Range("bddfacturesclients_concat_annee_mois") Then

'3.On cherche les valeurs de concatener a facturer-nom du client

Sheets("BDD VENTES").Activate

NBVAL = Application.CountA(Range("v_Producteur"))

a_facturer = "A facturer" & Cells(vide.Row, Range("v_Client").Column).Value

i = 1

With Worksheets("BDD VENTES").Range(Cells(1, Range("Concatener_Eligibilite_à_la_facturation_en_cours_client").Column), Cells(Range("balise_bas").Row, Range("Concatener_Eligibilite_à_la_facturation_en_cours_client").Column))

Set c = .Find(a_facturer, LookIn:=xlValues)

If Not c Is Nothing Then

firstAddress = c.Address

'on extrait le nom du client et on le colle en FACTURE CLIENT ET BDD FACTURES CLIENTS

Sheets("FACTURE CLIENT").Range("facclient_nom_du_client").Value = Cells(c.Row, Range("v_Client").Column).Value

Else: MsgBox ("pas de correspondance")

End If

End With

'ON PREPARE FACTURE CLIENT

Range(Range("facture_client_csg"), Range("facture_client_cid")) = ""

i = 1

Do 'c'est ce DO qui fait buger la génération duPDF

Sheets("BDD VENTES").Activate

With Worksheets("BDD VENTES").Range(Cells(i, Range("Concatener_Eligibilite_à_la_facturation_en_cours_client").Column), Cells(Range("balise_bas").Row, Range("Concatener_Eligibilite_à_la_facturation_en_cours_client").Column))

Set c = .Find(a_facturer, LookIn:=xlValues)

If Not c Is Nothing Then

c.Select

i = ActiveCell.Row

' ActiveCell.Offset(0, 1).Value = "test"

'ON COMPLETE LE NUMERO DE FACTURE CLIENT

Cells(i, Range("bddventes_N°_facture_client").Column).Value = n°facture_client_volant

'DANS FACTURE CLIENT papier ON RENSEIGNE LA PREMIERE COLONNE

Sheets("FACTURE CLIENT").Activate

Sheets("FACTURE CLIENT").Range("facture_client_balisebas_saisie").End(xlUp).Offset(1, 0).Select

j = ActiveCell.Row

Cells(j, Range("facture_client_date_exp").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Date_expedition").Column).Value

Cells(j, Range("facture_client_type").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Type_fromage").Column).Value

Cells(j, Range("facture_client_affinage").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Affinage").Column).Value

Cells(j, Range("facture_client_quantite").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Poids").Column).Value

Cells(j, Range("facture_client_PUHT").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Prix_confirmé").Column).Value

Else: MsgBox ("Extractions factures clients terminée")

End If

End With

Loop While i <= NBVAL And Not c Is Nothing

'ENREGISTREMENT DE LA FACTURE EN PDF

Sheets("FACTURE CLIENT").Activate

'et on enregistre en PDF

LaDate = Format(Range("facclient_date").Value, "yyyy_mm_dd")

LeParcours = Range("facclient_nom_du_client").Value

LeN°fac = Range("facclient_papier_N°").Value

chemin = LeRep & "_" & "fac N° " & LeN°fac & LeParcours & "_" & LaDate & ".pdf"

LeRep = "C:\Users\Bastres\Desktop\PIERRE\PRO\ANTOLA COOP\CLIENTS\SALGIZEKO GASNATEGIA\DEMO 08_03_2018\FACTURES CLIENTS\"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _

"C:\Users\Bastres\Desktop\PIERRE\PRO\ANTOLA COOP\CLIENTS\SALGIZEKO GASNATEGIA\DEMO 08_03_2018\FACTURES CLIENTS\" & chemin, Quality:= _

xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

From:=1, To:=1, OpenAfterPublish:=False

Loop While l <= NBVAL

End Sub

Le 21/02/2018 à 20:04

Bonsoir

Ton code est imbuvable, malgré l'heure de l'apéro... LOL

Tu pourrais l'indenter, mais même , quand cela est trop long à lire, pas évident

Donc pourrais-tu envoyer un extrait de ton fichier en retirant si nécessaire des données confidentielles....???

Merci

Le 21/02/2018 à 21:18

Bien sur,

voici une version allégée.

Ce qui est incompréhensible c'est que cela fonctionne en manuel.

15fichier-a-tester.xlsm (904.94 Ko)

Bonne soirée.

Pierre

Le 22/02/2018 à 00:09

bonsoir,

proposition de correction

Sub SAUVEGARDE_CREATION_AUTO_FACTURES_CLIENTS()
    Dim LaDate As String, LeParcours As String, LeRep As String, LeN°fac As String, chemin As String

    Dim i As Variant
    Dim ligne_volante As Variant
    ' ligne de la premiere cellule vide, c'est à dire non facturée
    Dim ancre_volante As Variant
    'valeur de concat année-mois-producteur qui est extrait de premiere cellule vide de BDD VENTES si concatannée mois est le bon
    Dim max As Variant
    'c'est la concat année_moi_producteur de référence et qui va prendre diff. valeurs en fonction du producteur
    Dim n°facture_client_volant As Variant
    ' ds BDD VENTES le N° de facture client qui s'incrément
    Dim NBVAL As Variant
    Dim a_facturer As Variant
    Dim c As Variant
    Dim firstAddress As Variant
    Dim j As Variant
    Dim cible As Variant
    Dim ba As Variant
    Dim vide As Variant
    Dim l As Variant

    '1.ON CREE LE NUMERO DE FACTURE CLIENT DS BDD VENTES ET ON LE REPORT DANS FACTURE CLIENT papier

    Sheets("BDD VENTES").Activate
    NBVAL = Application.CountA(Range("v_Producteur"))

    l = 1

    '2.On cherche la première valeur à facturer et on extrait le nom du client:
    'sera le filtre pr séparer les A FACTURER des autres clients

    Do

        Sheets("BDD VENTES").Activate
        Sheets("FACTURE CLIENT").Range("facclient_papier_N°").Value = Application.WorksheetFunction.max(Sheets("BDD VENTES").Range("bddventes_N°_facture_client").EntireColumn) + 1
        n°facture_client_volant = Sheets("FACTURE CLIENT").Range("facclient_papier_N°").Value

        With Worksheets("BDD VENTES").Range(Cells(l, Range("Eligibilite_à_la_facturation_en_cours").Column), Cells(Range("balise_bas").Row, Range("Eligibilite_à_la_facturation_en_cours").Column))

            Set vide = .Find("A facturer", LookIn:=xlValues)
            If Not vide Is Nothing Then
                'firstAddress = ba.Address
                l = vide.Row
                'On extrait le nom du client et on le colle dans facture papier
                Sheets("FACTURE CLIENT").Range("facclient_nom_du_client") = Cells(vide.Row, Range("v_Client").Column).Value
            Else
                If l = 1 Then
                    MsgBox ("Pas de facture en attente")
                Else
                    MsgBox ("Extractions factures clients terminée")
                End If
                Exit Sub
            End If
        End With
        'If Cells(vide.Row, Range("Concat_année_mois_n°facture").Column).Value = Sheets("BDD FACTURES CLIENTS").Range("bddfacturesclients_concat_annee_mois") Then

        '3.On cherche les valeurs de concatener a facturer-nom du client

        Sheets("BDD VENTES").Activate
        NBVAL = Application.CountA(Range("v_Producteur"))

        a_facturer = "A facturer" & Cells(vide.Row, Range("v_Client").Column).Value

        i = 1
        With Worksheets("BDD VENTES").Range(Cells(1, Range("Concatener_Eligibilite_à_la_facturation_en_cours_client").Column), Cells(Range("balise_bas").Row, Range("Concatener_Eligibilite_à_la_facturation_en_cours_client").Column))

            Set c = .Find(a_facturer, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                'on extrait le nom du client et on le colle en FACTURE CLIENT ET BDD FACTURES CLIENTS
                Sheets("FACTURE CLIENT").Range("facclient_nom_du_client").Value = Cells(c.Row, Range("v_Client").Column).Value
            Else
                MsgBox ("pas de correspondance")
            End If
        End With
        'ON PREPARE FACTURE CLIENT
        Range(Range("facture_client_csg"), Range("facture_client_cid")) = ""

        i = 1
        Do
            Sheets("BDD VENTES").Activate
            With Worksheets("BDD VENTES").Range(Cells(i, Range("Concatener_Eligibilite_à_la_facturation_en_cours_client").Column), Cells(Range("balise_bas").Row, Range("Concatener_Eligibilite_à_la_facturation_en_cours_client").Column))

                Set c = .Find(a_facturer, LookIn:=xlValues)
                If Not c Is Nothing Then
                    c.Select
                    i = ActiveCell.Row
                    '          ActiveCell.Offset(0, 1).Value = "test"
                    'ON COMPLETE LE NUMERO DE FACTURE CLIENT
                    Cells(i, Range("bddventes_N°_facture_client").Column).Value = n°facture_client_volant

                    'DANS FACTURE CLIENT papier ON RENSEIGNE LA PREMIERE COLONNE
                    Sheets("FACTURE CLIENT").Activate
                    Sheets("FACTURE CLIENT").Range("facture_client_balisebas_saisie").End(xlUp).Offset(1, 0).Select
                    j = ActiveCell.Row
                    Cells(j, Range("facture_client_date_exp").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Date_expedition").Column).Value
                    Cells(j, Range("facture_client_type").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Type_fromage").Column).Value
                    Cells(j, Range("facture_client_affinage").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Affinage").Column).Value
                    Cells(j, Range("facture_client_quantite").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Poids").Column).Value
                    Cells(j, Range("facture_client_PUHT").Column).Value = Sheets("BDD VENTES").Cells(i, Range("v_Prix_confirmé").Column).Value

                End If

            End With

        Loop While i <= NBVAL And Not c Is Nothing

        'ENREGISTREMENT DE LA FACTURE EN PDF

        Sheets("FACTURE CLIENT").Activate

        'et on enregistre en PDF

        LaDate = Format(Range("facclient_date").Value, "yyyy_mm_dd")
        LeParcours = Range("facclient_nom_du_client").Value
        LeN°fac = Range("facclient_papier_N°").Value
        chemin = "_" & "fac N°  " & LeN°fac & LeParcours & "_" & LaDate & ".pdf"
        LeRep = "C:\Users\Bastres\Desktop\PIERRE\PRO\ANTOLA COOP\CLIENTS\SALGIZEKO GASNATEGIA\DEMO 08_03_2018\FACTURES CLIENTS\"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
                                        LeRep & chemin, Quality:= _
                                        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                        From:=1, To:=1, OpenAfterPublish:=False
    Loop While l <= NBVAL

End Sub
Le 22/02/2018 à 07:36

Bonjour,

cela fonctionne très bien, formidable, merci beaucoup!

Je vois les modifs et j'essaye de comprendre la différence!

Pierre

Le 22/02/2018 à 10:10

Bonjour,

l'erreur se situe dans ces instructions

chemin = LeRep & "_" & "fac N° " & LeN°fac & LeParcours & "_" & LaDate & ".pdf"

tu mets une valeur dans chemin qui est composée de LeRep + un nom de fichier qui dépend de la facture, la date et le parcours

lors du premier passage dans la boucle LeRep ne contient rien. chemin contient donc uniquement le nom de fichier sans indication de répertoire.

lors du 2ème passage dans la boucle leREP contient C:\Users\Bastres\Desktop\PIERRE\PRO\ANTOLA COOP\CLIENTS\SALGIZEKO GASNATEGIA\DEMO 08_03_2018\FACTURES CLIENTS\

LeRep = "C:\Users\Bastres\Desktop\PIERRE\PRO\ANTOLA COOP\CLIENTS\SALGIZEKO GASNATEGIA\DEMO 08_03_2018\FACTURES CLIENTS\"

tu mets un nom de répertoire dans LeRep

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"C:\Users\Bastres\Desktop\PIERRE\PRO\ANTOLA COOP\CLIENTS\SALGIZEKO GASNATEGIA\DEMO 08_03_2018\FACTURES CLIENTS\" & chemin, Quality:= _

lors du premier passage tu écris dans un fichier C:\Users\Bastres\Desktop\PIERRE\PRO\ANTOLA COOP\CLIENTS\SALGIZEKO GASNATEGIA\DEMO 08_03_2018\FACTURES CLIENTS\ & chemin (qui ne contient que le nom de fichier)

lors des passages suivants tu écris dans un fichier C:\Users\Bastres\Desktop\PIERRE\PRO\ANTOLA COOP\CLIENTS\SALGIZEKO GASNATEGIA\DEMO 08_03_2018\FACTURES CLIENTS\ & chemin (qui contient aussi le nom du répertoire) VBA détecte un nom de fichier incorrect et bug...

les autres changements sont cosmétiques.

Le 22/02/2018 à 10:22

Ok, j'ai appris qq chose, merci.

Bonne continuation.

P.

Rechercher des sujets similaires à "bug lors generation pdf boucle"