Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
Dim Wsh As Object, z&, a&, chemin$
chemin = Environ("userprofile") & "\Desktop\" & Environ("username") & "-" & Me.Name & ".gif"
'vidage du clipboard
With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
Application.SendKeys "(%{1068})" 'touche impression ecran
'gestion d'attente pour laisser le cliboard digérer l'image de la capture
Do While z = 0 'utilisation des api sans declaration (compatible tout windows et office
z = ExecuteExcel4Macro("CALL(""user32"",""IsClipboardFormatAvailable"",""JJC""," & 2 & ")") '2 pour bitmap,14 pour wmf
DoEvents
Loop
With ActiveSheet.ChartObjects.Add(0, 0, Me.Width, Me.Height) 'creation graphique,paste,export,delete
.Chart.Paste: .Chart.Export chemin, "GIF": .Delete
End With
'controle et le cas echéant remise en route de la touche numlock
a = Excel.ExecuteExcel4Macro("CALL(""user32"", ""GetKeyState"", ""JJ"", " & &H90 & ")")
If a <> 0 Then
Set Wsh = CreateObject("wscript.shell")
Wsh.SendKeys "{NUMLOCK}", True ' si le pavénumerique est désactivé on le réactive
End If
MsgBox "L USERFORM : " & Me.Name & " a été capturé sous:" & vbCrLf & chemin
End Sub