Save an userform as an image in EXCEL
2007-10-04 18:17
621 查看
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 method is 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
'
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Private Const VK_LMENU = &HA4
Private Const VK_SNAPSHOT = &H2C
Private Const VK_CONTROL = &H11
Private Const VK_V = &H56
Private Const VK_0x79 = &H79
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim sAppOs As String
Dim wks As Worksheet
'get oparating system
sAppOs = Application.OperatingSystem
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Mid(sAppOs, 18, 2) = "NT" Then
' WinNT,Windows2000,WindowsXP - Using Win32API
Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
Else
' Windows95,Windows98,WindowsME
Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
End If
DoEvents
Unload Me
Set wks = Workbooks.Add.Sheets(1)
Application.Goto wks.Range("A1")
ActiveSheet.Paste
wks.SaveAs Filename:="D:/myfile.htm", FileFormat:=xlHtml
wks.Parent.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Have a look at D:/myfile.files folder."
End Sub
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 method is 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
'
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
Private Const VK_LMENU = &HA4
Private Const VK_SNAPSHOT = &H2C
Private Const VK_CONTROL = &H11
Private Const VK_V = &H56
Private Const VK_0x79 = &H79
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim sAppOs As String
Dim wks As Worksheet
'get oparating system
sAppOs = Application.OperatingSystem
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Mid(sAppOs, 18, 2) = "NT" Then
' WinNT,Windows2000,WindowsXP - Using Win32API
Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_LMENU, VK_V, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
Call keybd_event(VK_SNAPSHOT, VK_0x79, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
Else
' Windows95,Windows98,WindowsME
Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0)
Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0)
End If
DoEvents
Unload Me
Set wks = Workbooks.Add.Sheets(1)
Application.Goto wks.Range("A1")
ActiveSheet.Paste
wks.SaveAs Filename:="D:/myfile.htm", FileFormat:=xlHtml
wks.Parent.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Have a look at D:/myfile.files folder."
End Sub
相关文章推荐
- Save an userform as an image in EXCEL
- 【原创】在DataFormWebPart中将列表附件显示为图片(二)[How to display list item attachments as image in DFWP Part 2]
- SaveAs in Excel 2007-2010
- Save+as+Image+using+DrawingImage()+in+WPF
- PHPExcel_Reader_Exception: is not recognised as an OLE file in Classes
- FFMPEG -- Save streaming data as image in iOS
- Build Assetbundle出错:An asset is marked as dont save, but is included in the build
- Need to specify class name in environment or system property, or as an applet parameter, or in an ap
- 如何解决SharePoint 2013 Sign in as different user显示的问题
- Resizing a Form to Fit an Image
- 在使用jetty配置jndi的时候报错“Need to specify class name in environment or system property, or as an applet pa
- Need to specify class name in environment or system property, or as an applet parameter, or in an application resource file: java.naming.factory.init
- How to Integrate Excel in a Windows Form Application using the WebBrowser
- using vb.net export a datatable to Excel and save as file
- ubuntu 下解决phpmyadmin error: “Connection for controluser as defined in your configuration failed”
- Save a Microsoft Excel Workbook as a PDF File by Using PowerShell
- How to insert a resource image, as embedded image in email?
- [转贴]How to work with stored procedures by using script in an Office InfoPath 2003 form
- Connection for controluser as defined in your configuration failed.
- Export selection of word document as an image file