Save an userform as an image in EXCEL

When click a commandbutton in an Excel userform,save the entire userform as an image file in harddisk.

Method 1

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 MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType 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 OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As Guid, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Const VK_MENU = &H12
Private Const VK_SNAPSHOT = &H2C
Private Const KEYEVENTF_KEYUP = &H2
Private Const CF_BITMAP = 2
Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type

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

Private Sub CommandButton1_Click()
Dim Altscan As Double, hwnd As Long, Pic As PicBmp, IPic As IPicture, IID_IDispatch As Guid
DoEvents
Altscan = MapVirtualKey(VK_MENU, 0) 'Alt+PrintScrn
Keybd_Event VK_MENU, Altscan, 0, 0 'press Alt
Keybd_Event VK_SNAPSHOT, 0, 0, 0 'press PrintScrn
DoEvents
Keybd_Event VK_MENU, Altscan, KEYEVENTF_KEYUP, 0 'release it
OpenClipboard 0 'OpenClipboard
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

With Pic
.Size = Len(Pic)
.Type = 1
.hBmp = GetClipboardData(CF_BITMAP)
End With

OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic
stdole.SavePicture IPic, "c:\userform.bmp"
CloseClipboard
MsgBox "ok"
End Sub

Method 2

Another methodis from Emily's blog:

http://cat14051.mysinablog.com/index.php?op=ViewArticle&articleId=72135

The following code would save an userform as an image when you double click on the userform. With API, this code pastes an image of the form into a worksheet of the new workbook, then save it as a HTML file. When the Excel workbook is saved as a html file, all image files will be placed in the different folder.

'UserForm

'

PrivateDeclareSubkeybd_eventLib"user32"(ByValbVkAsByte,_

ByValbScanAsByte,_

ByValdwFlagsAsLong,_

ByValdwExtraInfoAsLong)

PrivateConstVK_LMENU=&HA4

PrivateConstVK_SNAPSHOT=&H2C

PrivateConstVK_CONTROL=&H11

PrivateConstVK_V=&H56

PrivateConstVK_0x79=&H79

PrivateConstKEYEVENTF_EXTENDEDKEY=&H1

PrivateConstKEYEVENTF_KEYUP=&H2

PrivateSubUserForm_DblClick(ByValCancelAsMSForms.ReturnBoolean)

DimsAppOsAsString

DimwksAsWorksheet

'getoparatingsystem

sAppOs=Application.OperatingSystem

Application.DisplayAlerts=False

Application.ScreenUpdating=False

IfMid(sAppOs,18,2)="NT"Then

'WinNT,Windows2000,WindowsXP-UsingWin32API

Callkeybd_event(VK_LMENU,VK_V,KEYEVENTF_EXTENDEDKEY,0)

Callkeybd_event(VK_SNAPSHOT,VK_0x79,KEYEVENTF_EXTENDEDKEY,0)

Callkeybd_event(VK_LMENU,VK_V,KEYEVENTF_EXTENDEDKEYOrKEYEVENTF_KEYUP,0)

Callkeybd_event(VK_SNAPSHOT,VK_0x79,KEYEVENTF_EXTENDEDKEYOrKEYEVENTF_KEYUP,0)

Else

'Windows95,Windows98,WindowsME

Callkeybd_event(VK_SNAPSHOT,0,KEYEVENTF_EXTENDEDKEY,0)

Callkeybd_event(VK_SNAPSHOT,0,KEYEVENTF_EXTENDEDKEYOrKEYEVENTF_KEYUP,0)

EndIf

DoEvents

UnloadMe

Setwks=Workbooks.Add.Sheets(1)

Application.Gotowks.Range("A1")

ActiveSheet.Paste

wks.SaveAsFilename:="D:/myfile.htm",FileFormat:=xlHtml

wks.Parent.CloseFalse

Application.ScreenUpdating=True

Application.DisplayAlerts=True

MsgBox"HavealookatD:/myfile.filesfolder."

EndSub