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.
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
sAppOs = Application.OperatingSystem
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Mid(sAppOs, 18, 2) = "NT" Then
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
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
分享到:
相关推荐
调用API让Excel2007中UserForm内控件listbox 使用鼠标滚轮源码 调用API让Excel2007中UserForm内控件listbox 使用鼠标滚轮源码 调用API让Excel2007中UserForm内控件listbox 使用鼠标滚轮源码 调用API让Excel2007中...
VBA编写的EXCEL数字秒表 Option Explicit Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _ ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Public ...
VBA VB6 让Excel2007中UserForm内控件listbox 使用鼠标滚轮源码 调用API方式 Excel2007测试运行通过 有需要赶快下载吧,谢谢支持
Save Workbooks as XML Section 15.3. Use XML Maps Section 15.4. Program with XML Maps Section 15.5. XmlMap and XmlMaps Members Section 15.6. XmlDataBinding Members Section 15.7. XmlNamespace...
vba控件常规使用UserForm 基础.docx
vba控件常规使用UserForm-基础.doc
Excel vba 用户窗体交互简单使用。将实现的功能: 读取所有sheet的名字 显示在窗体上 通过在窗体上选择想要的sheet的名字,输出打印到sheet1的单元格A1中。 将按钮修改名称为“确定”,点击确定即为确定选择内容...
UserForm1.Show 'If QXAN = 1 Then Exit Sub lx = JSLX Select Case BZJD Case "0" jd = 0 Case "0.0" jd = 1 Case "0.00" jd = 2 Case "0.000" jd = 3 Case "0.0000" jd = 4 End Select 'If QXAN = 1 Then Exit ...
counting text in a range.xlsx:一个演示计算区域内字符数量的各种方式的工作簿。 cumulative sum.xlsx:一个演示如何计算一个累积和的工作簿。 frequency distribution.xlsx:一个演示创建频率分布的四种方法的...
' The UserForm1_Activate sub calls Main UserForm1.LabelProgress.Width = 0 UserForm1.Show End Sub Private Sub UserForm_activate() Call Main End Sub Sub Main() ' Inserts random numbers on the active...
private sub commandbutton2-click() sheets(“班级”).select userform1.show end sub private sub commandbutton2-click() unload me sheets(“欢迎界面”).select end sub 作
Public Sub AddMenu(wform As MSForms.UserForm, sCaption As String, sAction As String, Optional Acc As String = vbNullString) Dim MenuLeft As Single, MenuWidth As Single '由两个标签和一个图形控件组成一...
'测试用例:新建一个EXCEL表格文件,工作表1为“Sheet1”,工作表2为“Sheet2” '鼠标右键点击工作表名Sheet1,弹出菜单中选择“查看代码(V)” '弹出Visual Basic For Applications窗口 '选择“插入(I)”的子菜单...
有关vba上的userform的一些问题的解决
hk-userform
" as 数量2, 数量,0 as 数量3, 0 as 金额2, 金额,0 as 金额3 from [入库$] union all select ""出库"" AS 表单选项,规格型号,机器号, 0 as 数量3, 0 as 数量2,数量, 0 as 金额3, 0 as 金额2,金额 from [出库$]" _ ...
ListView Controls As Well As ToolTips For Visual Basic Userform and Controls
VBA窗口顶置.xlsm
jquery/validation_engine表单提交验证,简单实用。将css和js引用,并在需要验证的元素class中填写相应参数,以及表单提交的方法中进行验证 $("#userForm").validateEngine("validate")。在项目中已经实用,很方便。
登陆窗体和关闭窗体,和实现进度条的使用。及透明度的使用。注解详细。