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
| '--------- Procédure à placer dans le module objet du UserForm ----------------
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
Private Const VK_LMENU = &HA4
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim wshTemp As Worksheet, Img
DoEvents
' Simulate pressing ALT+Printscreen to copy the form window (=picture) to
' the clipboard
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
DoEvents
' Add a worksheet named Temp
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = "Temp"
Set wshTemp = ThisWorkbook.Worksheets("Temp")
' Paste the picture, set print orientation to landscape en print it
With wshTemp
.Paste
With .PageSetup
.Orientation = xlLandscape
ActiveWindow.DisplayGridlines = False
ActiveSheet.Shapes.Range(1).Select
Selection.ShapeRange.ScaleWidth ((297 / 25.4) * 72 - (.LeftMargin + .RightMargin)) / Img.Width, msoFalse, msoScaleFromTopLeft
End With
.PrintOut
End With
' Delete the worksheet Temp and suppress the not-saved Warning.
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Temp").Delete
Application.DisplayAlerts = True
End Sub |
Partager