Macro enregistrement en pdf

Le 31/08/2017 à 09:05

Bonjour,

Je vous expose mon problème :

J'aimerais que lorsque je filtre mon tableau, je puisse enregistrer celui en format PDF dans un endroit ciblé avec le nom du fichier qui s'adapte au nom du client qui apparaît au début du tableau. Exemple du nom : Paul - calendrier au 30-08-17 et 31-08-17. Paul étant en A4 mais si je filtre sur John qui se trouve en première fois en A37, la macro ne fonctionne pas en effet j'ai mis A4 dans le code ... Comment prendre en compte le changement ?

Voici le fichier :

15enregistrement-pdf.xlsx (13.76 Ko)

Voici mon code :

Sub Export_PDF()
    Dim fichier As String
    With Worksheets("Histo")
        fichier = "\" & .Range("A4") & " " & "-" & " " & "calendrier au" & " " & .Range("F2") & " " & "et" & " " & .Range("F3") & ".pdf"
        Dossier = "C:\Users\utilisateur\Desktop\Travail\Test"
        chemin = Dossier & fichier
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
End Sub

Merci pour votre aide !

Le 31/08/2017 à 13:50

Bonjour,

pour récupérer la première ligne filtrer,

x = Range("_FilterDatabase").SpecialCells(xlCellTypeVisible).Address(0, 0)
If Range(Split(x, ",")(0)).Rows.Count >= 2 Then
  n = Range(Split(x, ",")(0)).Row + 1
Else
  n = Range(Split(x, ",")(1))(1).Row
End If

Édit: correction : >=2

Le 31/08/2017 à 14:19

Salut !

Merci de m'avoir répondu.

Ton code je l'insère comment dans le mien ?

Parce que quand je l'insère :

Sub Export_PDF()

    x = Range("_FilterDatabase").SpecialCells(xlCellTypeVisible).Address(0, 0)
If Range(Split(x, ",")(0)).Rows.Count >= 2 Then
  n = Range(Split(x, ",")(0)).Row + 1
Else
  n = Range(Split(x, ",")(1))(1).Row
End If
    Dim fichier As String
    With Worksheets("Histo")
        fichier = "\" & .Range("n") & " " & "-" & " " & "calendrier au" & " " & .Range("F2") & " " & "et" & " " & .Range("F3") & ".pdf"
        Dossier = "C:\Users\utilisateur\Desktop\Travail\Test"
        chemin = Dossier & fichier
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
End Sub

ça me met en jaune cette partie du code :

    x = Range("_FilterDatabase").SpecialCells(xlCellTypeVisible).Address(0, 0)
Le 31/08/2017 à 15:10

Bonjour,

à tester,

Sub Export_PDF()
    Dim fichier As String
    With Worksheets("Histo")
       x = .Range("_FilterDatabase").SpecialCells(xlCellTypeVisible).Address(0, 0)
        If Range(Split(x, ",")(0)).Rows.Count >= 2 Then
         n = Range(Split(x, ",")(0)).Row + 1
        Else
         n = Range(Split(x, ",")(1))(1).Row
        End If

        fichier = "\" & .Range("A" & n) & " " & "-" & " " & "calendrier au" & " " & .Range("F2") & " " & "et" & " " & .Range("F3") & ".pdf"
        Dossier = "C:\Users\utilisateur\Desktop\Travail\Test"
        chemin = Dossier & fichier
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
End Sub
Le 31/08/2017 à 15:28

ça me met toujours ce message d'erreur (Erreur d'exécution '1004' : Erreur définie par l'application ou par l'objet) avec cette ligne sur fond jaune :

       x = .Range("_FilterDatabase").SpecialCells(xlCellTypeVisible).Address(0, 0)
Le 31/08/2017 à 15:42

Re-bonjour Jizinho

Merci d'avoir mis ta demande ici plutôt qu'en MP, et surtout de l'avoir documentée avec un fichier simple et super.

Je ne suis pas intervenu car je ne connaissais pas cette solution proposée par notre ami SabV; j'avais bien en back-up une "autre" solution qui consistait par macro à d'abord choisir le nom du médecin, et faire par macro le filtre et l'édition en pdf.

Bonne continuation avec SabV, je vais suivre ce post.

sabV a écrit :

Bonjour,

pour récupérer la première ligne filtrer,

x = Range("_FilterDatabase").SpecialCells(xlCellTypeVisible).Address(0, 0)
If Range(Split(x, ",")(0)).Rows.Count >= 2 Then
  n = Range(Split(x, ",")(0)).Row + 1
Else
  n = Range(Split(x, ",")(1))(1).Row
End If

Édit: correction : >=2

Le 31/08/2017 à 15:58

Bonjour Jizinho , Steelson, à tous,

oups désolé je n'avais pas vu que c'est un Tableau,

du coup c'est plus simple, avec le Tableau la ligne de titre n'est pas pris en compte

Sub Export_PDF()
    Dim fichier As String
    With Worksheets("Histo")
        x = .Range("Tableau1").SpecialCells(xlCellTypeVisible).Address(0, 0)
        n = Range(Split(x, ":")(0)).Row
        fichier = "\" & .Range("A" & n) & " " & "-" & " " & "calendrier au" & " " & .Range("F2") & " " & "et" & " " & .Range("F3") & ".pdf"
        Dossier = "C:\Users\utilisateur\Desktop\Travail\Test"
        chemin = Dossier & fichier
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
End Sub
Le 31/08/2017 à 18:53

Je me dis que quand même, autant faire la manip en une fois : filtrer et éditer.

Je vais regarder ...

Le 31/08/2017 à 19:17

Exemple très simplifié ...

Sub Export_PDF()
    Dim fichier As String
    Dim toubib As String

    toubib = InputBox("Saisie du NOM : ")

    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=1, Criteria1:=toubib

    With Worksheets("Histo")
        fichier = "\" & toubib & ".pdf"
        dossier = "C:\Users\Michel\Desktop\"
        chemin = dossier & fichier
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With

End Sub

on peut ensuite faire une liste déroulante avec dico pour les noms à sélectionner.

Nota : cela n'enlève rien à la proposition de sabV

10enregistrement-pdf.xlsm (18.01 Ko)
Le 01/09/2017 à 03:45

Re-

Adapté exactement à tn cas, cela donnerait ceci :

Sub Export_PDF()
    Dim fichier As String
    Dim toubib As String
    toubib = InputBox("Saisie du NOM : ")
    With Worksheets("Histo")
        .ListObjects("Tableau1").Range.AutoFilter Field:=1, Criteria1:=toubib
        fichier = "\" & toubib & " " & "-" & " " & "calendrier au" & " " & .Range("F2") & " " & "et" & " " & .Range("F3") & ".pdf"
        Dossier = "C:\Users\utilisateur\Desktop\Travail\Test"
        chemin = Dossier & fichier
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
End Sub
Le 01/09/2017 à 07:58

Salut !

Tout d'abord merci à tous les deux d'avoir pris le temps de m'aider !

La solution de SabV fonctionne parfaitement, merci !!

Ta solution aussi Steelson, par contre comme tu sais les noms (dans le vrai fichier) sont longs donc le taper me ferait perdre du temps. Tandis qu'avec le filtre en tapant les 2 premières lettres je tombe dessus directement ^^ Mais pas bête comme idée lorsque ce sont des noms aussi courts que ceux-ci.

Merci !!

Le 01/09/2017 à 08:14
Jizinho a écrit :

La solution de SabV fonctionne parfaitement, merci !!

Bravo sabV, je n'en doutais pas, je crois que nous allons nous aussi progresser avec ses propositions !

Et belle coopération internationale. (et je suis déjà allé et à Liège et à Montréal)

Jizinho a écrit :

Ta solution aussi Steelson, par contre comme tu sais les noms (dans le vrai fichier) sont longs donc le taper me ferait perdre du temps. Tandis qu'avec le filtre en tapant les 2 premières lettres je tombe dessus directement ^^ Mais pas bête comme idée lorsque ce sont des noms aussi courts que ceux-ci.

En fait j'ai pour mini-projet (ou "ambition") de faire un menu déroulant à partir des noms contenus dans la colonne A, et donc tu auras aussi une saisie prédictive. Je te mettrai cela dès que j'ai un peu de temps.

Le 01/09/2017 à 13:43

Hello Liège et le Quebec,

je me suis fait un petit plaisir ...

15filtrer-puis-enregistrer-en-pdf.xlsm (25.22 Ko)
Le 05/09/2017 à 09:04

Salut !!

Merci à toi, comme ça c'est parfait !

Rechercher des sujets similaires à "macro enregistrement pdf"