Macro VBA pour imprimer un écran (formulaire) vers un fichier PDF

Version imprimable

Bonjour

pour imprimer un écran (formulaire) vers un fichier PDF j'utilise (vu dans FAQ)

L'image du UserForm est automatiquement placée dans le coin supérieur gauche de la page imprimée.

Il n'existe pas d'option pour centrer ou repositionner l'impression. La seule solution palliative consiste à faire une copie d'écran de la boîte de dialogue. Ensuite vous faites un collage dans la feuille de calcul en tant qu'image, pour la manipuler à votre guise.

Cet exemple imprime l'UserForm centré dans la page:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Option Explicit Private Declare Sub keybd_event Lib "user32" ( _ ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long) Private Sub CommandButton1_Click() Dim Ws As Worksheet 'Copie d'écran de la forme active keybd_event vbKeySnapshot, 1, 0&, 0& DoEvents 'Ajoute une feuille pour coller l'image de la forme Set Ws = Sheets.Add Ws.Paste 'impression centrée dans la page With Ws .PageSetup.CenterHorizontally = True .PageSetup.CenterVertically = True .PrintOut End With End Sub
mais je souhaite :
paramétrer le chemin et le fichier créé
avoir tous l'écran sur une page

Dans le FAQ et la doc microsoft (2013)

il y a
Code:

1 2 3 .PageSetup.PrinToFile = True .PageSetup.PrinToFileName = "C:\program files\apbene\stats\benevole_ind\nom&prenom.pdf" .PageSetup.PrintArea = "$A$1:$N$48"
mais celà ne me semble pas géré en Exel 2007

est-ce exact ?
merci de m'aider pour prendre en compte ces besoins en exel 2007
solution ?
paliatif ?

bien cordialement
MJ

15/08/2016, 12h02
kiki29

Salut, ici ou là pour l'enregistrement en bmp,jpeg puis PDFCreator 1.7.3 Conversion d'images Tif Bmp Png Jpg Gif d'un dossier dans un seul PDF résultant, en l'adaptant à ton contexte.

RE, voir PDFCreator Sauver une UserForm en PDF ou Excel 2007 Sauver une UserForm en PDF

suite impression ecran

bonjour et merci

voilà ce que j'ai repris et j'ai l'erreur 429 au

Code:

ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)

erreur 429 composant active X
ne peut créer d'objet
j'ai du faire une erreur

cordialement

mon code

Code:

1
2
3
4
5
6
7
8
Option Explicit  'Activation de la déclaration explicite des variables
 
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
        ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub CommandButton15_Click()
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
 
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.197)
        .RightMargin = Application.InchesToPoints(0.197)
        .TopMargin = Application.InchesToPoints(0.197)
        .BottomMargin = Application.InchesToPoints(0.197)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
    End With
 
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
 
 
 
    Application.DisplayAlerts = False
    Worksheets(Worksheets.Count).Delete
    Unload Me
    Application.DisplayAlerts = True
 
    Application.ScreenUpdating = True
End Sub
 
 
Private Sub PrintScreen()
   keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
  keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
 keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End Sub

15/08/2016, 17h58
unparia

Bonjour
La ligne de code que tu incrimines ne saurait provoquer normalement cette erreur.
Et même si le classeur était protégé, l'erreur dénoncée serait autre.
- quelle est ta version Excel ?
- que t'affiche :

Code:

Msgbox ThisWorkbook.name

mis juste avant cette ligne de code ?

impression accès

bonjour
merci pour votre aide
j'ai revérifié en créeant une nouvelle commande

la version est 12.0

avec ces infos j'obtiens toujours le même message (erreur 429) un composant activeX ne peut pas créer d'objet et l'erreur

a lieu sur

Code:

MsgBox ThisWorkbook.Name

encore merci

mj

Code:

1
2
3
4
5
6
7
8
9
10
11
Option Explicit  'Activation de la déclaration explicite des variables
Dim Ws As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim csp_invoked_init As String
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
        ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub CommandButton16_Click()
Dim sNomPDF As String
 
    Application.ScreenUpdating = False
 
    PrintScreen
    DoEvents
     MsgBox ThisWorkbook.Name
    ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
 
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.197)
        .RightMargin = Application.InchesToPoints(0.197)
        .TopMargin = Application.InchesToPoints(0.197)
        .BottomMargin = Application.InchesToPoints(0.197)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
    End With
 
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    sNomPDF = ActiveWorkbook.Path & "\" & "UserForm.pdf"
 
    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNomPDF, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
 
    Application.DisplayAlerts = False
    Worksheets(Worksheets.Count).Delete
    Unload Me
    Application.DisplayAlerts = True
 
    Application.ScreenUpdating = True
End Sub
 
Private Sub PrintScreen()
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End Sub

15/08/2016, 19h13
kiki29

1 pièce(s) jointe(s)
Salut, effectivement ne pratiquant pas l'extispicine .....
Bref si tu places un bouton sur une feuille de ton classeur pour visualiser l'UserForm avec ce code dans un module standard.
Code:

1 2 3 4 5 Option Explicit Sub Bouton1_QuandClic() UserForm1.Show End Sub
et le code du lien placé dans feuille UserForm avec un bouton CommandButton1 "Save As PDF" tu obtiendras ceci :
15/08/2016, 21h20
unparia

Citation:

un composant activeX ne peut pas créer d'objet et l'erreur

a lieu sur MsgBox ThisWorkbook.Name

révèle quant à lui que l'évocation de l'objet ThisWorkBook présente problème.
Quelle en est la cause ?
- l'appli Excel corrompue ? (et donc à réinstaller)
- une référence nécessaire décochée ?
- cette ligne de code n'est pas écrite dans l'un des modules appelants d'un classeur ! ???
Il faudrait venir sur ta machine pour en trouver la cause exacte.
15/08/2016, 21h45
michelj64

impression ecran

bonsoir

sur ce que tu me dis

- l'appli Excel corrompue ? (et donc à réinstaller)je vais voir un autre PC
- une référence nécessaire décochée ? j'avais vérifié mais
- cette ligne de code n'est pas écrite dans l'un des modules appelants d'un classeur ! ???
Il faudrait venir sur ta machine pour en trouver la cause exacte. comment ? e suis bénévole de chez bénévole

pour info
je dialogue entre mon formulaire principal et les autres formulaires en mode non modal voir la remarque de kiki
je ne suis jamais arrivé à utiliser les contrôles active x

j'ai travaillé avec mr couper coller et c'est ma première appli (bourde possible)

merci de l'aide
15/08/2016, 22h00
kiki29

Re, un échantillon qui ici fonctionne : Excel 2003 PDFCreator 1.7.3 : Sauvegarde UserForm en Pdf
15/08/2016, 22h56
michelj64

ce soir

bonsoir

cela va mieux

l'erreur q disparu

j'ai changé le chemin et le fichier et j'ai un bug que je regarde demain

bon soir

mj

bonjour

J"avais crée une sauvegarde automatique à la fermeture d' excel

cela
enrichie workbook avec
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 rivate Sub Workbook_Open() End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) ' pour save programme Application.DisplayAlerts = False ActiveWorkbook.SaveAs "c:cheminfichier.xls" Application.Quit End Sub
celà crée un workbook1 vide

jai mis workbook1 et celà semble fonctionner

Code:

ThisWorkbook1.Worksheets.Add After:=Worksheets(Worksheets.Count)

merci de votre aide

mj

18/08/2016, 00h20
kiki29

Salut, la version Excel 2007+

bonjour (unparia et kiki29)

je joins mon code (en gras mes modifications)

j'ai pris en compte
la gestion du nom (variable)
la date (dans le nom)
quelques cadrages
le remplacement de workbook par workbook1 (lien avec save au moment du close
je ne suis pas arrivé à masquer les feuillets (lien avec workbooki ?

bonne journée

Code:

1
2
3
4
5
6
7
8
Private Sub Workbook_Open()
 Dim sh As Worksheet
 For Each sh In ThisWorkbook.Worksheets
  With sh
   If Not .Name = "MENU" Then .Visible = xlSheetVeryHidden
  End With
 Next
End Sub

Code:

1
2
3
4
5
6
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
        ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Private Sub CommandButton16_Click()
'
' save as pdf_click()
'
Dim nom As String
Dim prenom As String
Dim sNomPDF As String
Dim JobPDF As Variant
nom = Me.TextBox1
prenom = Me.TextBox8
Dim np_conca As String
np_conca = nom & prenom
Dim nom_fichier As String
nom_fichier = np_conca
Dim chemin As Variant

chemin = "C:\program files\apbene\stats\benevole_ind\"
    
    
    Application.ScreenUpdating = False
 
    PrintScreen
    DoEvents

'


  ThisWorkbook1.Worksheets.Add After:=Worksheets(Worksheets.Count)
 
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.197)
        .RightMargin = Application.InchesToPoints(0.197)
        .TopMargin = Application.InchesToPoints(0.197)
        .BottomMargin = Application.InchesToPoints(0.1)   'ancien 0,197
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
    End With
 
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    
   sNomPDF = chemin & nom_fichier & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".pdf"
     
    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNomPDF, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
 
    Application.DisplayAlerts = False
    Worksheets(Worksheets.Count).Delete
    Unload Me
    Application.DisplayAlerts = True
 
    Application.ScreenUpdating = True
    Unload Me ' Vide et ferme l'Userform ( formulaire)
 UserForm1.Show False
End Sub
 
Private Sub PrintScreen()
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End Sub