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
| Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const VK_SNAPSHOT = &H2C
'
'
Sub clearclipboard(): OpenClipboard 0: EmptyClipboard: CloseClipboard: End Sub
'
'
Sub partscreenshot(position)
Dim maform, Nom As String, HanDle As Long, hPicAvail As Long, vbCom
clearclipboard ' apel de la sub de vidage du clipboard
'procédure de création de l'userform
Set maform = ThisWorkbook.VBProject.VBComponents.Add(3) ' ajout de l'userform temporaire
Nom = maform.Name ' determination de la variable nom
VBA.UserForms.Add (Nom) 'ajout du nom dans VBA
Set maform = UserForms(UserForms.Count - 1) 'identification du userform
With maform
.Show 0
HanDle = FindWindow(vbNullString, maform.Name) ' capture du handle de l'userform
SetWindowPos HanDle, 0, position(0), position(1), position(2), position(3), 0 ' positionnement de l'userform
'BringWindowToTop (FindWindow(vbNullString, maform.Caption))
ShowWindow HanDle, 5 'active la la fenetre userform
'tout l'userform est transparent (invisible)
SetWindowLong HanDle, -20, &HC0101
SetLayeredWindowAttributes HanDle, 0, 0, &H2
'Sleep 500
keybd_event VK_SNAPSHOT, 1, 1, 0 'on appuie sur la touche snapshot
keybd_event VK_SNAPSHOT, 1, &H2, 0 ' on relache la touche snapshot
Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(2): Loop While hPicAvail = 0 'gestion d'attente du bitmap dans le clipboard
Unload maform 'ferme l'userform
End With
ActiveSheet.Paste 'colle la capture sur le sheet
Set vbCom = Application.VBE.ActiveVBProject.VBComponents ' collection des module(vbcomponents)
vbCom.Remove VBComponent:=vbCom.Item(Nom) ' suppression de l'userform temporaire
End Sub |
Partager