Sauvegarder un userform en jpg

Question

Bonjour,
Je suis en train de dévelloper une application dans laquel je travail avec des userform.
Je n'arrive pas à trouver un code pour enregistrer l'userform3 avec tous sont contenu (tels un imprime écran) en .jpg ou .pdf afin de pouvoir l'envoyer par mail par la suite. J'ai déjà la partie qui envoie le mail mais je n'arrive pas à enregistrer le userform.
Es-ce que quelqu'un peux m'aider?

raffika · Answer

Salut,
j'ai un code pour cela, avec utilisation d'api de windows :
Déclarer la fonction bitblt du gdi32 au début du code comme
une variable :

    Private Declare Function BitBlt Lib "gdi32.dll" Alias "BitBlt" (ByVal _
       hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As _
       Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal _
       hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, _
       ByVal dwRop As System.Int32) As Long

En profiter pour déclarer une image qui servira de destination :

    Dim memoryImage As Bitmap

Ensuite déclarer la sub suivante :

Private Sub CaptureScreen()
        Dim mygraphics As Graphics = Me.CreateGraphics()
        Dim s As Size = Me.Size
        memoryImage = New Bitmap(s.Width, s.Height, mygraphics)
        Dim memoryGraphics As Graphics = Graphics.FromImage(memoryImage)
        Dim dc1 As IntPtr = mygraphics.GetHdc
        Dim dc2 As IntPtr = memoryGraphics.GetHdc

        BitBlt(dc2, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height, dc1, 0, 0, 13369376)

        mygraphics.ReleaseHdc(dc1)
        memoryGraphics.ReleaseHdc(dc2)
        PictureBox1.Image = memoryImage ' ici que picturebox contient le résultat

    End Sub 

Après, utilisation de la Sub :

        CaptureScreen()

Dans un bouton par exemple.
Ensuite dans la form, picturebox1 aura comme image
la form comme dans une capture d'écran, tu peux la
mettre à visible = false.

Ensuite sauvegarder en bmp le résultat, voici le code :

PictureBox1.Image.Save("fichiercapture.bmp")

Donc à placer dans la form à 'capturer'...

Voilà bonne prog

raffika · Answer

PS : il y a peut être un petit décalage à régler
qui doit correspondre aux cotés de la fenêtre windows.
Qui peut être réglé dans la commande :

 BitBlt(dc2, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height, dc1, 0, 0, 13369376)

ici : Me.ClientRectangle.Width & .Height aussi donc à réduire de quelques pixels.
Mais sinon comme le décalage ne coupe pas la capture et au contraire l'agrandi,
ça ne devrai pas poser de problème toutefois le titre de la fenêtre
et les boutons Croix Réduire Agrandir ne sont pas capturés.

28Coco28 · Answer

Merci beaucoup de ton aide, je test ça demain et je te tiens au courant.

28Coco28 · Answer

Après plusieurs essais, je n'arrive pas à mettre en marche ton code. j'ai toujours des lignes en rouge...
voici le code

Private Sub CommandButton4_Click()

Private Declare Function BitBlt Lib "gdi32.dll" (ByVal _
       hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As _
       Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal _
       hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, _
       ByVal dwRop As System.Int32) As Long
       
 Dim memoryImage As bitmap
 
'capture d'écran
 Dim mygraphics As Graphics
 mygraohics = UserForm3.CreateGraphics()
 Dim s As Size
 s = UserForm3.Size
 memoryImage = New bitmap(s.width,s.height,mygraphics)
 Dim memoryGraphics As Graphics
 memoryGraphics = Graphics.FromImage(memoryImage)
 Dim dc1 As IntPtr
 dc1 = mygraphics.GetHdc
 Dim dc2 As IntPtr
 dc2 = memoryGraphics.GetHdc

        BitBlt(dc2, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height, dc1, 0, 0, 13369376)
        mygraphics.ReleaseHdc (dc1)
        memoryGraphics.ReleaseHdc (dc2)
        PictureBox1.Image = memoryImage ' ici que picturebox contient le résultat        
 PictureBox1.Image.Save ("fichiercapture.bmp")



End Sub

raffika · Answer

Bon déjà il y a une faute de frappe :

Private Sub CommandButton4_Click() 

Private Declare Function BitBlt Lib "gdi32.dll" (ByVal _ 
hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As _ 
Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal _ 
hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, _ 
ByVal dwRop As System.Int32) As Long 

Dim memoryImage As bitmap 

'capture d'écran 
Dim mygraphics As Graphics 
mygraohics = UserForm3.CreateGraphics() '' ici , c'est pas mygraohics 
''mais mygraphics
Dim s As Size 
s = UserForm3.Size 
memoryImage = New bitmap(s.width,s.height,mygraphics) 
Dim memoryGraphics As Graphics 
memoryGraphics = Graphics.FromImage(memoryImage) 
Dim dc1 As IntPtr 
dc1 = mygraphics.GetHdc 
Dim dc2 As IntPtr 
dc2 = memoryGraphics.GetHdc 

BitBlt(dc2, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height, dc1, 0, 0, 13369376) 
mygraphics.ReleaseHdc (dc1) 
memoryGraphics.ReleaseHdc (dc2) 
PictureBox1.Image = memoryImage ' ici que picturebox contient le résultat 
PictureBox1.Image.Save ("fichiercapture.bmp") 



End Sub


Ensuite si ce code est dans la form à capturer,
Visual Basic te diras qu'il ne faut pas utiliser
le nom de la form (UserForm3) mais Me quand tu
est déjà dedans. Et enfin la Function BitBlt doit
être déclarée au début de coden, pas dans une Sub,
ce code marche :

Public Class Form1

    Private Declare Function BitBlt Lib "gdi32.dll" (ByVal _
hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As _
Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal _
hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, _
ByVal dwRop As System.Int32) As Long


    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click


        Dim memoryImage As Bitmap

        'capture d'écran 
        Dim mygraphics As Graphics
        mygraphics = Me.CreateGraphics() '' faute de frappe '' userform3


        Dim s As Size
        s = Me.Size '' userform3

        memoryImage = New Bitmap(s.Width, s.Height, mygraphics)
        Dim memoryGraphics As Graphics
        memoryGraphics = Graphics.FromImage(memoryImage)
        Dim dc1 As IntPtr
        dc1 = mygraphics.GetHdc
        Dim dc2 As IntPtr
        dc2 = memoryGraphics.GetHdc

        BitBlt(dc2, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height, dc1, 0, 0, 13369376)
        mygraphics.ReleaseHdc(dc1)
        memoryGraphics.ReleaseHdc(dc2)
        PictureBox1.Image = memoryImage ' ici que picturebox contient le résultat 
        PictureBox1.Image.Save("fichiercapture.bmp")

    End Sub
End Class

Remplace juste Me par Userform3 si tu veux capturer
une form dans laquelle n'est pas placé ce code.
Voilà, salut.

28Coco28 · Answer

je ne comprend pas où mettre le code? je le mettait dans le Private Sub CommandButton4_().
Doit-je le mettre dans Private Sub UserForm_Activate()

Parceque la ligne public Class Form1 du code que tu me donne et en rouge ainsi que le End Class.

Par ailleur: pour les ligne:

  memoryImage = New Bitmap(s.Width, s.Height, mygraphics)
'il me met attendu : fin d'instruction

Et

 BitBlt(dc2, 0, 0, Me.ClientRectangle.Width, Me.ClientRectangle.Height, dc1, 0, 0, 13369376)
'il me met attendu : =

ces commande sont bien pour vba sur excel?

raffika · Answer

Heu non c'est en VB.net...
Ton sujet est posté dans VB.net...
Tu aurais du le poster dans la section :
Visual Basic 6 -> VBA 
Après je ne sais pas si on peux traduire
le code en VBA Excel... Salut ^^'

28Coco28 · Answer

Ah... Désolé je pensait que c'était la même chose...
Désolé de t'avoir fait perdre ton temps et merci quand même de ton aide.
Cordialement

Utilisateur anonyme · Answer

Bonsoir,
Il existe une méthode relativement simple :
Dim b As New Bitmap(Me.Width, Me.Height)
Me.DrawToBitmap(b, New Rectangle(0, 0, Me.Width, Me.Height))
b.Save(Application.StartupPath & "\maform.jpg", Imaging.ImageFormat.Jpeg)

Bonne soirée.

Sauvegarder un userform en jpg

9 réponses

Votre réponse

Discussions similaires