×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

How to screenshot a userform and save the capture as JPG

How to screenshot a userform and save the capture as JPG

How to screenshot a userform and save the capture as JPG

(OP)
I've done this before in VB6, but is there a way in Excel VBA to screencapture the userform (already know how to do this), then save the image in the clipboard to a JPG file?

I recall that in VB6 if was a simple as sending the image to a picturebox control from the clipboard, then saving the picturebox control .PICTURE as a file (or something like that..I've slept a few times since I worked on that project! LOL), but I'm having a heck of a time finding a method to do something similar in Excel VBA...

Thanks in advance :)

------------------------------------
yinyang Over 35 years of programming, and still learning every day! yinyang

RE: How to screenshot a userform and save the capture as JPG

>then saving the picturebox control .PICTURE as a file

Not if you were trying to save as a jpeg! StdPic (and thus VB6's Picturebox control) could not understand jpegs. Sure, you could save to a file with a jpg extension, but what was actually saved was a bmp

RE: How to screenshot a userform and save the capture as JPG

(OP)
strongm, you prompted me to dig out my old notes on the process... you're right, that wasn't the method... I used this:

Microsoft Windows Image Acquisition Library v2.0 (wiaaut.dll)

FPATH = "C:\test.bmp"

Dim picfile As New WIA.ImageFile
Dim picprocess As New WIA.ImageProcess
Set picfile = New WIA.ImageFile


picfile.LoadFile FPATH
Set picprocess = New WIA.ImageProcess
With picprocess
.Filters.Add .FilterInfos!Convert.FilterID
.Filters.Item(1).Properties!FormatID.Value = wiaFormatJPEG
.Filters.Item(1).Properties!Quality.Value = 100
Set picfile = .Apply(picfile)
End With
picfile.SaveFile "c:\test.jpg"

------------------------------------
yinyang Over 35 years of programming, and still learning every day! yinyang

RE: How to screenshot a userform and save the capture as JPG

Yep, WIA 2 would be the route I'd have advised. We've covered it a number of times in this forum.

So, now all you need to do is somehow load picfile from the data on the clipboard ...

RE: How to screenshot a userform and save the capture as JPG

(OP)
Unfortunately, I'm not finding any way in VBA to work with the clipboard like VB6 can.... Hoping someone here has that expertise :)

------------------------------------
yinyang Over 35 years of programming, and still learning every day! yinyang

RE: How to screenshot a userform and save the capture as JPG

No, sadly VBA doesn't have a clipboard object (and the one it can access in the parent app, e.g. Excel) is less capable. It also doesn't have a PropertyBag object - which makes serialising a Picture object for consumption by WIA tricky ...

You goal is still possible though ...

RE: How to screenshot a userform and save the capture as JPG

CODE -->

Option Explicit

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Private Type EncoderParameter
   GUID As GUID
   NumberOfValues As Long
   type As Long
   Value As Long
End Type

Private Type EncoderParameters
   Count As Long
   Parameter As EncoderParameter
End Type

Private Type PictDesc
    cbSizeofStruct As Long
    PicType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type

Private Declare Function GdiplusStartup Lib "GDIPlus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal Token As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, BITMAP As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicArray As Any, RefIID As Any, ByVal OwnsHandle As Long, IPic As Any) As Long

Const PICTYPE_BITMAP = 1
Const CF_BITMAP = 2

Public Sub example()
    Dim ClipboardPic As Picture

    If OpenClipboard(0&) Then
        Set ClipboardPic = HandleToPicture(GetClipboardData(CF_BITMAP), PICTYPE_BITMAP) ' assumes we have a bitmap on the clipboard
        CloseClipboard
        If Not ClipboardPic Is Nothing Then
            SaveAsJPG ClipboardPic, "d:\downloads\deleteme\test.jpg"
        Else
            MsgBox "Could not find bitmap on clipboard"
        End If
    Else
        MsgBox "Could not open Clipboard"
    End If

End Sub

Private Function HandleToPicture(hHandle As Long, PicType As Long) As Picture
    Dim pd As PictDesc
    Dim IPic As GUID

    If hHandle = 0 Then Exit Function ' no handle to any type of image

    pd.cbSizeofStruct = Len(pd)
    pd.PicType = PicType
    pd.hImage = hHandle

    CLSIDFromString ByVal StrPtr("{00020400-0000-0000-C000-000000000046}"), IPic
    OleCreatePictureIndirect pd, IPic, -1, HandleToPicture

End Function

Private Sub SaveAsJPG(ByVal SrcPicture As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 80)
Dim gdiInput As GdiplusStartupInput
Dim gdiStatus As Long
Dim Token As Long
Dim gdiImage As Long
Dim gdiJPGEncoder As GUID
Dim gdiEncoderParams As EncoderParameters

   ' Initialize GDI+
   gdiInput.GdiplusVersion = 1
   gdiStatus = GdiplusStartup(Token, gdiInput)

   If gdiStatus = 0 Then

      ' Create the GDI+ bitmap from the image handle
      gdiStatus = GdipCreateBitmapFromHBITMAP(SrcPicture.Handle, SrcPicture.hpal, gdiImage)

      If gdiStatus = 0 Then ' Successful?

         ' Initialize the encoder GUID
         ' assumes platform has a JPG codec; in real world we might want to enumerate codecs to see if this assumption is true. See my gdi+ code in thread222-1686785: Converting a bitmap generated by a webcam to a jpg: Converting a bitmap generated by a webcam to a jpg for one way of doing this
         CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), gdiJPGEncoder

         ' Initialize the encoder parameters - we are setting up Quality encoder
         gdiEncoderParams.Count = 1
         With gdiEncoderParams.Parameter
            CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
            .NumberOfValues = 1
            .type = 4
            .Value = VarPtr(quality) '0-100%
         End With

         ' Save the image
         gdiStatus = GdipSaveImageToFile(gdiImage, StrPtr(filename), gdiJPGEncoder, gdiEncoderParams)

         ' Cleanup
         GdipDisposeImage gdiImage

      End If

      ' Shutdown GDI+
      If Token Then GdiplusShutdown Token

   End If

   If gdiStatus Then msgbox "Could not save - GDI+ error"

End Sub 

RE: How to screenshot a userform and save the capture as JPG

(OP)
WOW!!
Thanks Strongm, you're the best :)

------------------------------------
yinyang Over 35 years of programming, and still learning every day! yinyang

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login


Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close