zoukankan      html  css  js  c++  java
  • 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 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
  • 相关阅读:
    JavaScript----数组方法
    JavaScript----数组
    JavaScript----Array.foreach()
    JavaScript----数字及数字方法
    JavaScript----函数,对象及字符串方法
    设计模式@第5章:单例设计模式
    设计模式@第4章:设计模式概述
    设计模式@第3章:UML 类图
    部署方案@常用软件的安装
    应用框架@SpringBoot
  • 原文地址:https://www.cnblogs.com/fengju/p/6336272.html
Copyright © 2011-2022 走看看