Capture écran userform

Version imprimable

Voir 40 message(s) de cette discussion en une page

hello,
le souci avec JGOPBD c'est que :
1 - On ne sait pas ce qu'il veut exactement (ex: la copie s'effectue à partir du Userform ou de la feuille du classeur ? UserForm déjà affiché ?)
2 - On ne connait pas sa configuration (version d'excel , 32 ou 64 bits , O.S windows 7? Windows 10?)
3 - Ce qu'il utilise exactement quand il teste (code complet)
3 - On ne sait pas quand ça ne fonctionne pas ce qui se passe (message d'erreur, rien, plantage ?).

Citation:

Envoyé par Ben_L

Tu utilises VK_MENU (qui vaut 18, soit 12 en héxa) en lieu et place de VK_LMENU (qui vaut 164, soit A4 en héxa).

Cela m'étonnerait fortement que le problème de JGOPBD vienne de là car VK_MENU et VK_LMENU sont équivalents : la touche alt
Je pencherais plutôt sur le fait que peut être que JGOPBD est en excel 64 bits et alors la déclaration de keybd_event n'est pas bonne. Il faut alors :
Code:

1 2 3 4 5 6 #If VBA7 Then Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _ ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr) #Else Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _ ByVal dwFlags As Long, ByVal dwExtraInfo As Long) #EndIf
Citation:

Envoyé par Ben_L

En outre, l'utilisation de la fonction Wait rend ton code dépendant de valeurs de temps rentrées en dur, ce qui est plutôt déconseillé et ne sert à rien ici.

Je ne serais pas aussi catégorique :
Dans mon code :
1 - Le premier Wait ne sert que pour laisser le temps au Userform à s'afficher. Si il est déjà affiché cela effectivement ne sert à rien.
2 - Pour le deuxième (juste après la commande du snapshot) si on l'enlève, le presse papier peut ne pas avoir le temps de se remplir avant que l'on fasse le paste. Expérience , vider le presse papier et essayer la macro. Chez moi cela ne fonctionne pas sans cette tempo.
3 - Le troisième à mon avis n'est pas nécessaire non plus.

Ami calmant, J.P

17/08/2020, 11h54
Ben_L

Bonjour à tous,

Citation:

Envoyé par jurassic pork

Cela m'étonnerait fortement que le problème de JGOPBD vienne de là car VK_MENU et VK_LMENU sont équivalents : la touche alt

J'avoue que je l'ignorais. J'avais simplement testé le code que j'avais proposé et, comme il fonctionnait sans problème, j'ai supposé que le problème de JGOPBD provenait des différences avec ce code.
Mais comme vous le faîtes remarquer :

Citation:

Envoyé par jurassic pork

le souci avec JGOPBD c'est que : [...]

et en effet, je manquais largement d'éléments précis pour déterminer l'origine de l'erreur...

Concernant ma remarque relative à l'utilisation de la fonction Wait, vous indiquez :

Citation:

Envoyé par jurassic pork

Je ne serais pas aussi catégorique :

Pour être tout à fait franc, je ne cherchais pas à être aussi catégorique que je l'ai été.
Je ne suis pas expert en programmation informatique et ma remarque reflétait avant tout une position personnelle.

Je laisse de côté vos 1^er et 3^ème Wait, qui peuvent effectivement être assez facilement supprimés.
Pour le deuxième, j'avais cru comprendre qu'un "DoEvents" suffisait pour permettre à Windows de remplir correctement le presse-papier. Mais en effet, de nouveaux tests m'ont montré que j'avais tort, et vous raison.

De façon générale, Wait présente (selon moi) l'inconvénient de forcer à utiliser une durée pré-déterminée. Cela contraint à effectuer une attente bien plus longue que la durée moyenne de chargement de l'objet que l'on souhaite attendre.
Mais si cela fonctionne alors que les autres méthodes, non, alors mes "préférences" ont assez peu d'importance :aie:

Je vais quand même chercher une solution de contournement, mais cet effort semble voué à l'échec... Je vous tiens informés si je trouve quelque chose.

Cdt

Pour une raison que j'ignore, effectuer la copie 2 fois permet de contourner le problème sans avoir à attendre plusieurs centaines de millisecondes...

Le code suivant me paraît fonctionnel (aucun de mes essais n'a conduit à une erreur) :

Code:

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
Option Explicit
 
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1
 
 
Private Sub CommandButton1_Click()
    Dim i As Integer
    ClearClipboard
    CopyWndwAsImg
    CopyWndwAsImg
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
End Sub
 
 
Private Sub ClearClipboard()
    OpenClipboard 0&
    EmptyClipboard
    CloseClipboard
    DoEvents
End Sub
 
 
Private Sub CopyWndwAsImg()
    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
End Sub

Dans les cas où je n'effectuais la copie qu'une seule fois, il me fallait boucler sur un DoEvents jusqu'à une vingtaine de fois.
Avec une double copie, aucune boucle ne semble plus nécessaire.
Si quelqu'un est capable d'expliquer ce comportement, je suis preneur :mrgreen: !

hello,
j'ai trouvé un autre moyen pour être sûr que le collage va fonctionner. On teste si le presse-papier n'est plus vide :mrgreen: . Comme ceci par exemple :
Code:

1 2 3 4 5 Private Declare Function CountClipboardFormats Lib "user32" () As Long Private Function IsClipboardEmpty() As Boolean IsClipboardEmpty = (CountClipboardFormats() = 0) End Function
Le test :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub CommandButton1_Click()' CopyUserFormToWorksheet Dim i As Integer ClearClipboard CopyWndwAsImg i = 1 Do While IsClipboardEmpty() DoEvents Debug.Print i i = i + 1 Loop ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False End Sub
chez moi le nombre de boucles varie de 3 à 8 et le collage fonctionne à chaque fois.
Ami calmant, J.P

Bonjour.
Nous n'avons peut-être pas tous les mêmes configurations et donc les mêmes problèmes avec cette fonction.
Pour ma part (Excel 2010 avec Windows 10) tout marche bien, SAUF :
- la fonction ClearClipboard,
- l'instruction ActiveSheet.PasteSpecial,
- et quand il y a des données dans le clavier (par exemple suite à un contrôle C ou une impression écran).

Solution que j'ai retenue : je teste le tampon du clavier avec GetClipboardData pour savoir s'il y a du texte ou une image dans le tampon clavier.
Tant que c'est le cas, je boucle sur CopyWndwAsImg pour faire un Alt-Imp écran.
A noter que j'ai supprimé VK_MENU et VK_SNAPSHOT car le VBA connaît ces valeurs : vbKeyMenu et vbKeySnapshot (voir "Constantes de code de touches")

Le code:

Code:

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
 
Option Explicit
 
Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
'---------------------------------------------------------------------------------------
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
'---------------------------------------------------------------------------------------
 
'---------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
'---------------------------------------------------------------------------------------
Dim hbm  As Long
 
' Retourne le handle du clavier:
hbm = IsClipboardData
 
' Boucle pour faire un Alt-Imp écran tant que le clavier n'a pas l'image:
While IsClipboardData = hbm Or hbm = 0
    CopyWndwAsImg
Wend
 
' Affiche l'image en A10:
Sheets("Feuil1").Paste Range("A10")
End Sub
 
'---------------------------------------------------------------------------------------
Private Sub CopyWndwAsImg()
'---------------------------------------------------------------------------------------
    keybd_event vbKeyMenu, 0, 0, 0
    keybd_event vbKeySnapshot, 0, 0, 0
    keybd_event vbKeySnapshot, 0, 2, 0
    keybd_event vbKeyMenu, 0, 2, 0
    DoEvents
End Sub
 
'---------------------------------------------------------------------------------------
Public Function IsClipboardData() As Long
'---------------------------------------------------------------------------------------
' Retourne le handle du clavier s'il contient du texte ou une image,
' ou retourne 0 si le clavier est vide de texte ou d'image.
'---------------------------------------------------------------------------------------
OpenClipboard 0
IsClipboardData = GetClipboardData(CF_TEXT) + GetClipboardData(CF_BITMAP)
CloseClipboard
End Function
'---------------------------------------------------------------------------------------

Cordialement.

hello,

Citation:

Envoyé par laurent_ott

moi aussi je suis en Excel 2010 sous windows 10 et je n'ai pas de souci avec le ClearClipBoard et l'activeSheet.PasteSpecial sachant que le ClearClipBoard n'est pas une Api windows mais une fonction définie comme ceci :

Code:

1
2
3
4
5
6
Private Sub ClearClipboard()  
    OpenClipboard 0&
    EmptyClipboard
    CloseClipboard
    DoEvents
End Sub

le ClearClipboard avant la capture sert justement à ce qu'il n'y ait pas de contenu dans le presse-papier avant la capture.
Pourquoi parles-tu de tampon clavier ? Le clipboard représente le presse-papier à ma connaissance.
Le plus grave :aie: c'est que ta boucle :

Code:

1
2
3
4
' Boucle pour faire un Alt-Imp écran tant que le clavier n'a pas l'image:
While IsClipboardData = hbm Or hbm = 0
    CopyWndwAsImg
Wend

est infernale et ne rend pas la main quand le presse-papier est vide à l'origine car on aura toujours hbm = 0
En résumé voilà le code entier qui fonctionne chez moi et qui devrait fonctionner aussi en excel 64 bits :

Code:

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
Option Explicit
 
' https://www.developpez.net/forums/d2088646/logiciels/microsoft-office/excel/macros-vba-excel/capture-ecran-userform/#post11605894
#If VBA7 Then
Private Declare PtrSafe Sub keybd_event Lib "User32" (ByVal bVk As Byte, _
        ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function CountClipboardFormats Lib "User32" () As LongPtr
#Else
Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, _
        ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function OpenClipboard Lib "User32" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
Private Declare Function CountClipboardFormats Lib "User32" () As Long
#End If
 
 
 
'=====================================================================
'- SUBROUTINE : PRINT SCREEN & PASTE INTO THE WORKSHEET
'- events and SendKeys work slowly, so need lots of delays in the code
'- ALT+PrtScrn copies active window
'- PrtScrn copies the entire desktop
'=====================================================================
Sub CopyUserFormToWorksheet()
    Dim i As Integer
    ClearClipboard
    CopyWndwAsImg
    i = 1
    Do While IsClipboardEmpty()
     DoEvents
     Debug.Print i
     i = i + 1
   Loop
    '---------------------------------------------------------------
    '- paste picture to worksheet
   ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
   'Sheets("Feuil1").Paste Range("A10")
   DoEvents
End Sub
'=====================================================================
 
 
Sub ShowUserForm()
Dim i As Integer
Dim deb As Double, fin As Double
Dim hbm  As Long
deb = Timer * 1000#
UserForm1.Show (False)
Application.Wait Now + TimeValue("00:00:02")
ClearClipboard
deb = Timer * 1000#
CopyWndwAsImg
i = 1
Do While IsClipboardEmpty()
    DoEvents
    Debug.Print i
    i = i + 1
Loop
fin = Timer * 1000#
Debug.Print "Temps capture écran : ", fin - deb
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
'Sheets("Feuil1").Paste Range("A10")
End Sub
 
 
Sub CopyWndwAsImg()
'---------------------------------------------------------------------------------------
    keybd_event vbKeyMenu, 0, 0, 0
    keybd_event vbKeySnapshot, 0, 0, 0
    keybd_event vbKeySnapshot, 0, 2, 0
    keybd_event vbKeyMenu, 0, 2, 0
    DoEvents
End Sub
 
 
Private Function IsClipboardEmpty() As Boolean
    IsClipboardEmpty = (CountClipboardFormats() = 0)
End Function
 
 
Private Sub ClearClipboard()
    OpenClipboard 0&
    EmptyClipboard
    CloseClipboard
    DoEvents
End Sub

La macro ShowUserForm fait apparaître le Userform et la capture.
La macro CopyUserFormToWorksheet est à lancer à partir d'un bouton du Userform.

Le temps de capture chez moi varie de 40ms à 80ms

Ami calmant, J.P

Voir 40 message(s) de cette discussion en une page