Bonjour a tous
avant finalisation je souhaiterais plusieurs retours

en effet le sujet ayant été demander plusieurs fois ces derniers jours j'ai fait une petite macro pour la capture D'une portion d'écran

le principe simulation des touche impression écran sur la fenêtre active
le principe
ajout d'un userform dynamique rendu invisible par les api
capture de celui ci donc ce qu'il y a en dessous
le soucis avec la récupération de la capture dans le clipboard (et c'est pas nouveau) c'est la lenteur du clipboard a digérer les informations
pour cela j'ai utilisé l'api isclipboardformatavailable sur le format BITMAP présent dans le clipboard dans un do/loop d'attente qui règle le problème

comme nous n'avons pas tous les même pc (plus ou moins lents) j'ai besoins de voir si cela corresponde au plus grand nombre

avant de finaliser la sauvegarde par un chart ou par les api( je n'ai pas encore décidé)
merci de vos retours

la sub d'appel
la variable position contient exactement un array (left,top,width,height) attention en pixel le dimensionnement étant fait avec l'api setwindowpos
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
Sub test()
   Dim position
   position = Array(50, 300, 400, 450) ' en pixel
    partscreenshot position
End Sub
la sub de capture
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
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
je demanderais aussio une participation pour l'adaptation des api en 64 bits
ne pouvant pas tester car j'utilise plus que 2007 en 32

merci d'avance pour vos retours