Discussion :

[michelj64]

Bonjour

VBA EXCEL 2007

Pour sauvegarder un écran (image d'un écran) dans un fichier PDF j'ai suivi le tuto de KIKI29 (commentaire unparia)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 http://excel.developpez.com/telecharger/detail/id/4828/Excel-2007plus-Sauvegarde-UserForm-en-Pdf

Cela fonctionnait parfaitement mais mon userform a évolué et

- dépasse la hauteur d' un écran (j'ai du scrolling)

- je m'en sers pour préparer les éditions

et je ne récupère (dans le pdf) qu'une page au lieu de 2


En fonction du scrolling j'ai toujours dans le PDF , la partie visible dans l'écran :

- début de l'userform
ou
- fin de l'userform

J'ai fait plusieurs essais (ex sur PRINTAREA) sans succès




merci pour votre aide

cordialement MJ

[clementmarcotte]

Bonjour,

Je ne me suis pas imposé toute l'oeuvre de KiKi29, mais est-ce qu'il y a un facteur de zoom parmi tout cela ?

[kiki29]

Salut, l'exemple est dispo ici

Dans ce dernier il y a .Zoom = 150 et .Orientation = xlLandscape pour adapter l'userform au format de sortie, donc voir avec ces paramètres : Zoom moindre et xlPortrait ainsi que les marges.

[michelj64]

merci pour vos réponses, je regarderais cet apm

bonne journée

[kiki29]

Re, dans le code de l'UserForm pour la procédure CommandButton1_Click, mettre en commentaire temporairement cette partie du code.
Cela permet de voir l'emplacement de la copie d'écran dans la feuille et de créer via le macro recorder la mise en page idoine qui sera à placer dans cette procédure.

[michelj64]

bojour


j'ai fait l'essai (voir pj)

je joins mon code :
(j'utilise dropbox pour donner la visibilité.......)
je suis en train de tester l'utilisation de retour à la ligne dans une textbox


merci pour l'aide

mj

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
Private Sub CommandButton16_Click()
'
' Edition des informations du bénévole
'             Formulaire1 + compétences allouées + missions
' Création d'un fichier PDF
'
 
Dim h As Integer
Dim nom As String
Dim prenom As String
Dim nom_bencomp As String       ' nom dans les données disque
Dim prenom_bencomp As String    ' prénom dans les données disque
Dim code_bencomp As String
Dim partage_bencomp As String
 
Dim sNomPDF As String
Dim JobPDF As Variant
Dim ws4 As Variant
Dim libel_comp As String
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 = chemin_1 & "gest_benevole\accords\benevole_ind\"
Set ws4 = Sheets("liste competences par personne")
 
  '               extraction des noms et prénom et codesdepuis classeur trié sur nom et prénom
  '
 
  ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell   'saut de page
  libel_comp = "   Compétences : code  "
  libel_comp = libel_comp & Chr(13)                                 'saut de ligne
 
 
     For h = 2 To ws4.Range("A" & Rows.Count).End(xlUp).Row
           code_bencomp = ws4.Range("B" & h).Value
           nom_bencomp = ws4.Range("C" & h).Value
           partage_bencomp = ws4.Range("E" & h).Value
           prenom_bencomp = ws4.Range("D" & h).Value
           If nom <> nom_bencomp Then GoTo selec_no
           If prenom <> prenom_bencomp Then GoTo selec_no
           libel_comp = libel_comp & code_bencomp & Chr(13)
 
selec_no:          Next
 
Me.TextBox14 = libel_comp
    Application.ScreenUpdating = False
 
    PrintScreen
    DoEvents
 
'
 
 
  ThisWorkbook2.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 = xlPortrait
        .Zoom = 70
        End With
 
 'passage en mode non partagé
 
     ' Mode SHARED "OFF" à l'ouverture
    If ActiveWorkbook.MultiUserEditing Then
    Application.DisplayAlerts = False ' Pas de message d'erreur
    ActiveWorkbook.ExclusiveAccess ' Accès exclusif activé !
    Application.DisplayAlerts = True
    End If
 
 
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
 
    Chemin = chemin_1 & "gest_benevole\rapports\benevole_ind\"
 
   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
 
 ' Sauvegarde en réactivant le partage !
'If Not ActiveWorkbook.MultiUserEditing Then
'Application.DisplayAlerts = False
'ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, accessMode:=xlShared
'Application.DisplayAlerts = True
'End If
 
 '   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