Discussion :

[the_qd]

Bonjour,

Je voudrais pouvoir faire un copié ou une capture d'écran d'un formulair/état afin de le coller, manuellement, sur un pdf.

Auparavant, j'utilisais Excel et il me suffisait de faire un bête copier des cellules et de coller le résultat dans un pdf


Mais maintenant avec Access, je ne sais pas comment procéder.

Je peux sans autre générer un état ou un formulaire avec les données qu'il me faut mais ensuite comment copier ou capturer ledit état/formulaire dans le clipboard afin de le coller dans mon pdf?

Je vous remercie pour votre aide

[User]

Bonsoir,

Vous avez la possibilité d'exporter votre état dans un fichier pdf :

Code :

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

1
2
DoCmd.OpenReport "repClient", acViewPreview, , "NumClient=2"
DoCmd.OutputTo acOutputReport, , "PDF", "d:\test.pdf"

Pour plus d'info suivre ce lien.

[the_qd]

Bonjour,

Je vous remercie pour la proposition mais ce n'est ce que je recherche à faire, je voudrais capturer une image afin de la coller manuellement sur un pdf existant et non générer un pdf

Auriez-vous une autre idée ?

[hyperion13]

Salut,
une piste ici peut-être.

[the_qd]

Salut,

J'avais déjà testé cette solution mais je suis incapable de modifier le code pour définir une zone de capture

[the_qd]

J'ai trouvé une solution à mon problème

A défaut de printscreen, je cherchais également une possibilité de faire un copier-coller et j'ai trouvé une solution sur internet.

Au lieu de faire une formulaire avec plusieurs champs, il suffit que je mette toutes mes informations dans un seul champ texte et que je copie l'intégralité du contenu de ce champs

Code :

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

1
2
3
 
Me.txt_a_copier.SetFocus
DoCmd.RunCommand acCmdCopy

Le résultat est le même que si je faisais mon copier-coller depuis excel.

Merci pour votre aide

[EricDgn]

Bonjour,

Un outil de capture d'image tel que greenshot ne pourrait-il convenir?

Cordialement.

[the_qd]

Bonjour,

Non car mon but est d'automatiser au maximum afin que l'utilisateur n'ait qu'à faire un clic pour copier et un clic pour coller sans lui laisser le choix de ce qu'il pourrait capturer.

Mais comme indiqué j'ai trouvé ma solution en m'orientant plutôt sur un copier coller qu'une capture d'écran

[krononox]

Bonjour à tous,

avec du retard je peux partager mon vieux code qui fonctionne depuis plus de 10 ans.
Il permet de faire une capture d'écran de l'intérieur de la fenêtre active access (formulaire).
Donc même fenétrée, il ne capture que l'intérieur de la fenêtre et pas tout l'écran.

il permet de sauvegarder éventuellement dans un fichier bmp.
Fonctionne sous tous les windows (à adapter peut être si office 64bits)

il requiert la reference "OLE AUTOMATION" (normalement activé par defaut dans vba)


pour tester, créer un nouveau formulaire avec un bouton.
sur l'évenement click, appeler la procédure CaptureEcran (mettre CaptureEcran ,"currentproject.path & "\Capture.bmp" pour enregistrer l'image)

Code :

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

sub CaptureEcran(Optional Hwnd_FormDialog As Long = 0, Optional CheminFichier As String = "")

dans un module copier le code

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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
'*****************
'*****************
' Made by KRONONOX
' Libre d'utilisation
'*****************
'*****************
Option Explicit
 
Private Const HWND_DESKTOP As Long = 0
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
 
Private Declare Function ShellExecuteA Lib "shell32.dll" _
(ByVal Hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
'Does the clipboard contain a bitmap/metafile?
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
 
'Ouverture du clipboard pour lecture
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
 
'Pointeur bitmap/metafile
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
 
'Fermeture clipboard
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
 
'Convertir handle en OLE IPicture interface.
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll"  (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long,  IPic As IPicture) As Long
 
'Créer notre propre copie du métafichier, afin qu'il ne soit pas effacé par les mises à jour ultérieures du presse-papiers.
Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
 
'Créer notre propre copie du bitmap, afin qu'il ne soit pas effacé par les mises à jour ultérieures du presse-papiers.
Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1  As Long, ByVal N1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
 
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC  As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Sub CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any)
Private Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As Rect) As Long
 
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
         ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
         ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
         ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal index As Long) As Long
Const SM_CXSCREEN = 0  'Largeur  screen
Const SM_CYSCREEN = 1  'Hauteur screen
Const SM_CXVSCROLL = 2  'Largeur de la barre verticale scroll bar (à utiliser si on ne veut pas voir la scrollbar)
Const SM_CYHSCROLL = 3  'hauteur de la barre horizontale scroll bar (à utiliser si on ne veut pas voir la scrollbar)
Const SM_CYCAPTION = 4  'Hauteur de la barre de titre
Const SM_CXBORDER = 5  'Width of window frame that cannot be sized
 
Const SM_CXFRAME = 32 'la taille de la bordure gauche et droite de la fenetre
Const SM_CYFRAME = 33 'la taille de la bordure haut et bas de la fenetre
 
'API format types
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4
 
 
'Declare UDT pour GUID (IPicture OLE Interface)
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
 
'Declare UDT pour sauvegarder les infos du bitmap
Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
End Type
 
 
'type rectangle pour la copie d'ecran
Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
 'type Picture
 Private Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type
 
 
' Obtient le texte du message pour les erreurs OLE standard
Private Function fnOLEError(lErrNum As Long) As String
    'valeur de retour de OLECreatePictureIndirect
    Const E_ABORT = &H80004004
    Const E_ACCESSDENIED = &H80070005
    Const E_FAIL = &H80004005
    Const E_HANDLE = &H80070006
    Const E_INVALIDARG = &H80070057
    Const E_NOINTERFACE = &H80004002
    Const E_NOTIMPL = &H80004001
    Const E_OUTOFMEMORY = &H8007000E
    Const E_POINTER = &H80004003
    Const E_UNEXPECTED = &H8000FFFF
    Const S_OK = &H0
 
    Select Case lErrNum
        Case E_ABORT
            fnOLEError = " Aborted"
        Case E_ACCESSDENIED
            fnOLEError = " Access Denied"
        Case E_FAIL
            fnOLEError = " General Failure"
        Case E_HANDLE
            fnOLEError = " Bad/Missing Handle"
        Case E_INVALIDARG
            fnOLEError = " Invalid Argument"
        Case E_NOINTERFACE
            fnOLEError = " No Interface"
        Case E_NOTIMPL
            fnOLEError = " Not Implemented"
        Case E_OUTOFMEMORY
            fnOLEError = " Out of Memory"
        Case E_POINTER
            fnOLEError = " Invalid Pointer"
        Case E_UNEXPECTED
            fnOLEError = " Unknown Error"
        Case S_OK
            fnOLEError = " Success!"
    End Select
End Function
 
'Procédure de capure d'écran
'retourne false si erreur
Private Function CaptureEcranBMP(Optional chemin As String = "", Optional Hwnd As Long = 0) As Boolean
Dim AccessHwnd As Long
Dim hDC As Long
Dim hdcMem As Long
Dim Rect As Rect
Dim junk As Long
Dim FWidth As Long
Dim FHeight As Long
Dim hBitmap As Long
Dim HTitre As Long
Dim HBordure As Long
 
On Error GoTo Erreur
 
 
 
DoCmd.Hourglass True
 
'---------------------------------------------------
' handle Microsoft Access
'---------------------------------------------------
'si le hwnd=0 alors on recupere le formulaire actif de l'application access
' Attention, il faut envoyer le hwnd pour une fenetre boite de dialogue !
If Hwnd = 0 Then
    AccessHwnd = Screen.ActiveForm.Hwnd
    Else
    AccessHwnd = Hwnd
End If
'recuper la zone rectangle pour la création de l'image
Call GetWindowRect(AccessHwnd, Rect)
 
'récupere les hauteurs titre et bordure
HTitre = GetSystemMetrics(SM_CYFRAME)
HBordure = GetSystemMetrics(SM_CXFRAME)
'éventuellement récuperer les scrollbar
'xxxx= GetSystemMetrics(SM_CXVSCROLL)
'yyyy= GetSystemMetrics(SM_CYHSCROLL)
 
 
'définit hauteur et largeur en enlevant les bordures extérieure de access
FWidth = Rect.Right - Rect.Left - (HBordure * 2)
FHeight = Rect.Bottom - Rect.Top - (HTitre * 2) - GetSystemMetrics(SM_CYCAPTION)
'enlever également les xxxx et yyyy si pas de scrollbar
 
 
'---------------------------------------------------
' allocation mémoire
'---------------------------------------------------
hDC = GetDC(AccessHwnd)
hdcMem = CreateCompatibleDC(hDC)
hBitmap = CreateCompatibleBitmap(hDC, FWidth, FHeight)
 
If hBitmap <> 0 Then
    junk = SelectObject(hdcMem, hBitmap)
    '---------------------------------------------
    ' Copy bitmap en memoire
    ' base sur les coordonnées de Access
    '---------------------------------------------
    junk = BitBlt(hdcMem, 0, 0, FWidth, FHeight, hDC, 0, 0, &HCC0020)
    '---------------------------------------------
    ' ouvre Clipboard and copie le bitmap
    '---------------------------------------------
    junk = OpenClipboard(AccessHwnd)
    junk = EmptyClipboard()
    junk = SetClipboardData(CF_BITMAP, hBitmap)
    junk = CloseClipboard()
End If
 
 
'*************************************************
'si on souhaite créer un fichier bitmap de la capture.
'*************************************************
 
'--------------------------------------
' cree l'image en l'enregistrant en bmp
'--------------------------------------
If chemin > "" Then
    ' IPicture requiert la reference à "OLE Automation"
    Dim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture
    'OLE Picture types
    Const PICTYPE_BITMAP = 1
    Const PICTYPE_ENHMETAFILE = 4
    ' Creation Interface GUID (pour l'interface IPicture)
    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
 
    With uPicInfo
        .Size = Len(uPicInfo) ' Longueur structure.
        .Type = PICTYPE_BITMAP ' Type Picture
        .hPic = hBitmap ' Handle image.
    End With
 
    ' Creation Objet Picture.
    r = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)
 
    ' Si erreur, description
    If r <> 0 Then Debug.Print "Create Picture: " & fnOLEError(r)
 
    SavePicture IPic, chemin
 
 
Else
'si pas de création bitmap, la capture est toujours dans le presse papier
MsgBox "Vous pouvez maintenant coller la capture dans word, excel ou autres", vbInformation
End If
 
 
 
'---------------------------------------------
' Nettoyage handles
'---------------------------------------------
junk = DeleteDC(hdcMem)
junk = ReleaseDC(AccessHwnd, hDC)
 
CaptureEcranBMP = True
 
Resume_Erreur:
DoCmd.Hourglass False
Exit Function
 
 
Erreur:
MsgBox "Erreur de capture écran !" & vbCrLf & Err.Description, vbCritical
Err.Clear
CaptureEcranBMP = False
Resume Resume_Erreur
 
 
End Function
 
 
'pour une fenetre boite de dialogue, il faut envoyer le hwnd de la fenetre
'attribuer une valeur à cheminfichier pour enregistrer la capture
Public Sub CaptureEcran(Optional Hwnd_FormDialog As Long = 0, Optional CheminFichier As String = "")
Dim bRet As Boolean
 
'lance la création de la capture d'écran
bRet = CaptureEcranBMP(CheminFichier, Hwnd_FormDialog)
 
'ouvre le bmp si fichier
If bRet And CheminFichier > "" Then ShellExecuteA  Application.hWndAccessApp, "open", CheminFichier, vbNullString,  vbNullString, 1
 
End Sub