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
| 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 IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const VK_SNAPSHOT = &H2C
Private Sub CommandButton1_Click()
Dim hPicAvail As Long, T,Handle,chemin
Handle = fwa(vbNullString, Me.Caption)
chemin = Environ("userprofile") & "\Desktop\" & Me.Name & ".jpg"
SetWindowLongA Handle, -16, &H94080080: SetWindowLongA Handle, -20, &H0: DrawMenuBar Handle ' on enleve la caption(l'encadrement)on garde que l'interieur
With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With 'methode 1
keybd_event VK_SNAPSHOT, 1, 0, 0: keybd_event VK_SNAPSHOT, 1, &H2, 0 'on appuie et on relache la touche snapshot
'on va boucler dans que le contenu du clipboard n'est pas BITMAP soit (2)
Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(2): Loop While hPicAvail = 0 'Or (Timer - T) > 1000
'crée un graphique
With ActiveSheet.ChartObjects.Add(0, 0, Me.Width, Me.Height)
.Chart.Paste: .Chart.Export chemin, "jpg" 'colle l'image dans graphique puis exportation le graphique en image jog
.Delete 'supprime le chart
End With
SetWindowLongA Handle, -16, &H94C80080: DrawMenuBar Handle 'on remet la caption au userform
MsgBox "capture effectuée" & vbCrLf & chemin
End Sub |
Partager