Code VBA mprimer tous les reçus en pdf dans le meme emplacement?

Bonjour Forum,

svp j'ai realisé un programme des reçus contient deux feuilles

BD base de données

R contient des reçus,en changeant J10 la feuille R le reçu se remplie autoumatiquent (recherchev)

w2 la feuille R contient =max pourqu'elle apporte le nombre des bénéficiaires

svp j'ai besoin d'un code vba pour l'inserer au bouton imp reçus pour qu'il puisse imprimer tous les reçus en pdf dans le meme emplacement ou se trouve ce fichier xlsm

et Merci d'avance.

Bonjour

j'ai commencé par ce code:

option Explicit

Sub pdf()

    ActiveWorkbook.Worksheets("BD").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BD").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("BD").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",R[-1]C+1)"
    Range("A3").Select
    Selection.AutoFill Destination:=Range("A3:A10000")
    Range("A3:A10000").Select
If Not ActiveSheet.Name Like "R*" Then Exit Sub 'sécurité
Dim chemin$, rep As Byte, a$, h&, i&
chemin = ThisWorkbook.Path & "\dossier reçus pdf\"

If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du dossier

        MsgBox "dossier de sauvgarde a été crée."

Application.ScreenUpdating = False
With ActiveSheet
    .P

        a = .PageSetup.PrintArea
        h = .Range(a).Rows.Count
        .Copy 'nouveau document
        With ActiveSheet
            .PageSetup.PrintArea = ""
            For i = 1 To Val(.[w2] - 1)
                .Range(a).EntireRow.Offset(h * i - h).Copy .[A1].Offset(h * i)
                .[K10].Offset(h * i) = i + 1
                .HPageBreaks.Add Before:=.[A1].Offset(h * i) 'saut de page
            Next
            .PageSetup.PrintArea = .Range(a).Resize(h * i).Address
            .PageSetup.FitToPagesTall = i
            .ExportAsFixedFormat xlTypePDF, chemin & "Groupé.pdf"
            .Parent.Close False 'fermeture du document
        End With
        MsgBox "terminé"

End With
End Sub

Mais donne des érreurs

Bonjour hicham2610,

voici un exemple, j'ai créé une liste déroulante (voir ici pour en savoir plus - lien) pour sélectionner la valeur dans la base de données.

Je joins le fichier adapté et ci-dessous le code

Sub Export_Recu()
    'https://forum.excel-pratique.com/excel/code-vba-mprimer-tous-les-recus-en-pdf-dans-le-meme-emplacement-174943

    Dim Fichier     As String, Dossier As String, Chemin As String
    Dim plage       As Range
    Dim first       As Variant
    Dim r           As Range, c As Range, inputRange As Range

    Set plage = Range("Reçu")

    ' Location of DataValidation cell
    Set r = Worksheets("R").Range("J10")
    ' Get DataValidation values
    Set inputRange = Evaluate(r.Validation.Formula1)

    Application.ScreenUpdating = False

    For Each c In inputRange
        If first = "" Then first = c.Value
        If c <> "" Then
            r.Value = c.Value

            With Worksheets("R")
                Fichier = .Range("F14")
                Dossier = ThisWorkbook.Path & "\"

                Chemin = Dossier & Fichier
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, Quality:=xlQualityStandard, _
                                     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

            End With
        End If

    Next c
    ' réinitialiser
    r = first

    MsgBox "terminé"

    Application.ScreenUpdating = True

End Sub

Bonsoir sequoyah, Bonsoir Forum

Merci infiniment sequoyah

Le code donne erreur dexecution-1004

Set inputRange = Evaluate(r.Validation.Formula1) en jaune

svp

quelques suggestions

Merci d'avance

Bonjour hicham2610 et le Forum,

Je pense que l'erreur est due à l'absence de la liste déroulante dans ton fichier (cellule J10 de la feuille R qui renvoie à la liste de la colonne A de la feuille BD - Origine =BD!$A$2:$A$304 ), as-tu essayé avec mon fichier d'exemple?

Bien cordialement.

ici le lien

https://support.microsoft.com/fr-fr/office/créer-une-liste-déroulante-7693307a-59ef-400a-b769-c5402dce407b