Save an userform as an image in EXCEL

原创 2007年10月04日 18:17:00

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
版权声明:本文为博主原创文章,未经博主允许不得转载。

相关文章推荐

HowTo compile native C codes to a library for iOS development in Xcode – take Mosquitto as an exampl

HowTo compile native C codes to a library for iOS development in Xcode – take Mosquitto as an exampl...

《How hard can it be? Estimating the difficulty of visual search in an image》和 PPT

《How hard can it be? Estimating the difficulty of visual search in an image》发表于2016年CVPR上,这篇文章是老师推荐的...

数字图像处理实验(2):PROJECT 02-02, Reducing the Number of Gray Levels in an Image

实验要求: Reducing the Number of Gray Levels in an Image Objective To understand how the number ...

If you are behind an HTTP proxy, please configure the proxy settings either in IDE or Gradle.(AS报错)

If you are behind an HTTP proxy, please configure the proxy settings either in IDE or Gradle.问题解决方案

Effects with the Pixel Bender Toolkit – Part 5: Applying a filter to an image in Flash

Requirements User level BeginningRequired products Flash Player 10 and later Flash Professional (Dow...

SharePoint - Register an assembly as a safe control in the Web.config file

SharePoint - Register an assembly as a safe control in the Web.config file In order for you to use ...

how to use a SQLite database in a standalone program with an HTML interface and VBScript as the programming language

This article describes how to use a SQLite database in a standalone program with an HTML interface a...

Reference Pivot Fields and Pivot Items in an Excel Pivot Table, using VBA

This section explains how to access, reference, select or use Pivot Fields and Pivot Items in a Pivo...
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:深度学习:神经网络中的前向传播和反向传播算法推导
举报原因:
原因补充:

(最多只允许输入30个字)