LoadImage PNG在excel vba中形成image1.picture控件,黑色背景(LoadImage PNG in excel vba form image1.picture control, black background)

其他开发 IT屋
百度翻译此文   有道翻译此文
问 题

I have code which load png images to picture control

Option Explicit
Option Private Module

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

Private Type PICTDESC
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
End Type

Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

Private Declare Function GdiplusStartup Lib "GDIPlus" ( _
    token As Long, _
    inputbuf As GdiplusStartupInput, _
    Optional ByVal outputbuf As Long = 0) As Long

Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" ( _
    ByVal FileName As Long, _
    bitmap As Long) As Long

Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" ( _
    ByVal bitmap As Long, _
    hbmReturn As Long, _
    ByVal background As Long) As Long

Private Declare Function GdipDisposeImage Lib "GDIPlus" ( _
    ByVal Image As Long) As Long

Private Declare Function GdiplusShutdown Lib "GDIPlus" ( _
    ByVal token As Long) As Long

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
    PicDesc As PICTDESC, _
    RefIID As GUID, _
    ByVal fPictureOwnsHandle As Long, _
    IPic As IPicture) As Long

Public Function LoadImage(ByVal strFName As String) As IPicture
    Dim uGdiInput As GdiplusStartupInput
    Dim hGdiPlus As Long
    Dim hGdiImage As Long
    Dim hBitmap As Long

    uGdiInput.GdiplusVersion = 1

    If GdiplusStartup(hGdiPlus, uGdiInput) = 0 Then
        If GdipCreateBitmapFromFile(StrPtr(strFName), hGdiImage) = 0 Then
            GdipCreateHBITMAPFromBitmap hGdiImage, hBitmap, 0
            Set LoadImage = ConvertToIPicture(hBitmap)
            GdipDisposeImage hGdiImage
        End If
            GdiplusShutdown hGdiPlus
    End If
End Function

Public Function ConvertToIPicture(ByVal hPic As Long) As IPicture
    Dim uPicInfo As PICTDESC
    Dim IID_IDispatch As GUID
    Dim IPic As IPicture

    Const PICTYPE_BITMAP = 1

    With IID_IDispatch
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With

    With uPicInfo
        .Size = Len(uPicInfo)
        .Type = PICTYPE_BITMAP
        .hPic = hPic
        .hPal = 0
    End With

    OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic

    Set ConvertToIPicture = IPic
End Function

But png images loading with black backgrounds instead of transparent? how to fix this?

解决方案

I use this function (note the function can be in a separate module):

Private Sub UserForm_Activate()
With Me.Image1
    .BorderStyle = fmBorderStyleNone
    .PictureSizeMode = fmPictureSizeModeZoom
    .BackStyle = fmBackStyleTransparent
    .Picture = LoadImage("C:\images\MinersBag.png")
End With
end sub


Public Function LoadImagePat(ByVal h$) As IPicture 'si LoadImage ne marche pas , ou ne fait pas la transparance correct :
'code by lepelletier Patrick 28/02/2016

Dim Aff As Boolean
Dim Pic As Shape
With Application
    Aff = .ScreenUpdating
    .ScreenUpdating = False
End With
Set Pic = ActiveSheet.Pictures.Insert(h).ShapeRange(1)
With Pic
    .Copy
    Set LoadImagePat = PastePicture
    .Delete
End With
Set Pic = Nothing
If Aff Then Application.ScreenUpdating = True
End Function

The PastPicture routine is by Stephen Bullen and is found here (direct download link). In case of link rot, here is a copy of modPastePicture. Save it all into modPastePicture.bas, then import that file into the VBA editor.

Attribute VB_Name = "modPastePicture"
'***************************************************************************
'*
'* MODULE NAME:     Paste Picture
'* AUTHOR & DATE:   STEPHEN BULLEN, Office Automation Ltd
'*                  15 November 1998
'*
'* CONTACT:         Stephen@oaltd.co.uk
'* WEB SITE:        http://www.oaltd.co.uk
'*
'* DESCRIPTION:     Creates a standard Picture object from whatever is on the clipboard.
'*                  This object can then be assigned to (for example) and Image control
'*                  on a userform.  The PastePicture function takes an optional argument of
'*                  the picture type - xlBitmap or xlPicture.
'*
'*                  The code requires a reference to the "OLE Automation" type library
'*
'*                  he code in this module has been derived from a number of sources
'*                  discovered on MSDN.
'*
'*                  To use it, just copy this module into your project, then you can use:
'*                      Set Image1.Picture = PastePicture(xlPicture)
'*                  to paste a picture of whatever is on the clipboard into a standard image control.
'*
'* PROCEDURES:
'*   PastePicture   The entry point for the routine
'*   CreatePicture  Private function to convert a bitmap or metafile handle to an OLE reference
'*   fnOLEError     Get the error text for an OLE error code
'***************************************************************************

Option Explicit
Option Compare Text

''' User-Defined Types for API Calls

'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

'Declare a UDT to store the bitmap information
Private Type uPicDesc
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
End Type

'''Windows API Function Declarations

'Does the clipboard contain a bitmap/metafile?
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long

'Open the clipboard to read
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

'Get a pointer to the bitmap/metafile
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long

'Close the clipboard
Private Declare Function CloseClipboard Lib "user32" () As Long

'Convert the handle into an OLE IPicture interface.
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

'Create our own copy of the metafile, so it doesn't get wiped out by subsequent clipboard updates.
Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long

'Create our own copy of the bitmap, so it doesn't get wiped out by subsequent clipboard updates.
Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long

'The API format types we're interested in
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG = &H4

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: PastePicture
'''
''' Purpose:    Get a Picture object showing whatever's on the clipboard.
'''
''' Arguments:  lXlPicType - The type of picture to create.  Can be one of:
'''                          xlPicture to create a metafile (default)
'''                          xlBitmap to create a bitmap
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 30 Oct 98   Stephen Bullen      Created
''' 15 Nov 98   Stephen Bullen      Updated to create our own copies of the clipboard images
'''

Function PastePicture(Optional lXlPicType As Long = xlPicture) As IPicture

'Some pointers
Dim h As Long, hPicAvail As Long, hPtr As Long, hPal As Long, lPicType As Long, hCopy As Long

'Convert the type of picture requested from the xl constant to the API constant
lPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)

'Check if the clipboard contains the required format
hPicAvail = IsClipboardFormatAvailable(lPicType)

If hPicAvail <> 0 Then
    'Get access to the clipboard
    h = OpenClipboard(0&)

    If h > 0 Then
        'Get a handle to the image data
        hPtr = GetClipboardData(lPicType)

        'Create our own copy of the image on the clipboard, in the appropriate format.
        If lPicType = CF_BITMAP Then
            hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
        Else
            hCopy = CopyEnhMetaFile(hPtr, vbNullString)
        End If

        'Release the clipboard to other programs
        h = CloseClipboard

        'If we got a handle to the image, convert it into a Picture object and return it
        If hPtr <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, lPicType)
    End If
End If

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: CreatePicture
'''
''' Purpose:    Converts a image (and palette) handle into a Picture object.
'''
'''             Requires a reference to the "OLE Automation" type library
'''
''' Arguments:  None
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 30 Oct 98  Stephen Bullen      Created
'''

Private Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture

' IPicture requires a reference to "OLE Automation"
Dim r As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture

'OLE Picture types
Const PICTYPE_BITMAP = 1
Const PICTYPE_ENHMETAFILE = 4

' Create the Interface GUID (for the IPicture interface)
With IID_IDispatch
    .Data1 = &H7BF80980
    .Data2 = &HBF32
    .Data3 = &H101A
    .Data4(0) = &H8B
    .Data4(1) = &HBB
    .Data4(2) = &H0
    .Data4(3) = &HAA
    .Data4(4) = &H0
    .Data4(5) = &H30
    .Data4(6) = &HC
    .Data4(7) = &HAB
End With

' Fill uPicInfo with necessary parts.
With uPicInfo
    .Size = Len(uPicInfo)                                                   ' Length of structure.
    .Type = IIf(lPicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)  ' Type of Picture
    .hPic = hPic                                                            ' Handle to image.
    .hPal = IIf(lPicType = CF_BITMAP, hPal, 0)                              ' Handle to palette (if bitmap).
End With

' Create the Picture object.
r = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)

' If an error occured, show the description
If r <> 0 Then Debug.Print "Create Picture: " & fnOLEError(r)

' Return the new Picture object.
Set CreatePicture = IPic

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: fnOLEError
'''
''' Purpose:    Gets the message text for standard OLE errors
'''
''' Arguments:  None
'''
''' Date        Developer           Action
''' --------------------------------------------------------------------------
''' 30 Oct 98   Stephen Bullen      Created
'''

Private Function fnOLEError(lErrNum As Long) As String

'OLECreatePictureIndirect return values
Const E_ABORT = &H80004004
Const E_ACCESSDENIED = &H80070005
Const E_FAIL = &H80004005
Const E_HANDLE = &H80070006
Const E_INVALIDARG = &H80070057
Const E_NOINTERFACE = &H80004002
Const E_NOTIMPL = &H80004001
Const E_OUTOFMEMORY = &H8007000E
Const E_POINTER = &H80004003
Const E_UNEXPECTED = &H8000FFFF
Const S_OK = &H0

Select Case lErrNum
Case E_ABORT
    fnOLEError = " Aborted"
Case E_ACCESSDENIED
    fnOLEError = " Access Denied"
Case E_FAIL
    fnOLEError = " General Failure"
Case E_HANDLE
    fnOLEError = " Bad/Missing Handle"
Case E_INVALIDARG
    fnOLEError = " Invalid Argument"
Case E_NOINTERFACE
    fnOLEError = " No Interface"
Case E_NOTIMPL
    fnOLEError = " Not Implemented"
Case E_OUTOFMEMORY
    fnOLEError = " Out of Memory"
Case E_POINTER
    fnOLEError = " Invalid Pointer"
Case E_UNEXPECTED
    fnOLEError = " Unknown Error"
Case S_OK
    fnOLEError = " Success!"
End Select

End Function

本文地址:IT屋 » LoadImage PNG in excel vba form image1.picture control, black background

问 题

我有加载png图片到图片控制的代码

  Option Explicit 
Option Private Module

私有类型GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7)As Byte
End Type

私人类型PICTDESC
尺寸为长
类型为长
hPic为长
hPal为长
最终类型

私人类型GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type

Private Declare Function GdiplusStartup Lib“ GDIPlus“(_
令牌为Long,_
inputbuf为GdiplusStartupInput,_
可选ByVal outputbuf As Long = 0)As Long

Private Declare Function GdipCreateBitmapFromFile Lib” GDIPlus“(_
ByVal FileName As Long,_
位图As Long)As Long

Private Declare Function GdipC reateHBITMAPFromBitmap Lib“GDIPlus”(_
ByVal bitmap As Long,_
hbmReturn As Long,_
ByVal background As Long)As Long

Private Declare Function GdipDisposeImage Lib “GDIPlus”(_
ByVal Image As Long)As Long

Private Declare Function GdiplusShutdown Lib“GDIPlus”(_
ByVal token As Long)As Long

Private Declare Function OleCreatePictureIndirect Lib“olepro32.dll”(_
PicDesc As PICTDESC,_
RefIID As GUID,_
ByVal fPictureOwnsHandle As Long,_
IPic As IPicture )As Long

Public Function LoadImage(ByVal strFName As String)As IPicture
Dim uGdiInput As GdiplusStartupInput
Dim hGdiPlus As Long
Dim hGdiImage As Long
Dim hBitmap As Long
$ b uGdiInput.GdiplusVersion = 1

如果GdiplusStartup(hGdiPlus,uGdiInput)= 0那么
如果GdipCreateBitmapFromFile(strPtr(strFName),hGdiImage)= 0然后
GdipCreateHBITMAPFromBitmap hGdiImage,hBitmap,0
设置LoadImage = ConvertToIPicture(hBitmap)
GdipDisposeImage hGdiImage
End If
GdiplusShutdown hGdiPlus
End If
End Function

Public Function ConvertToIPicture(ByVal hPic As Long)As IPicture
Dim uPicInfo As PICTDESC
Dim IID_IDispatch As GUID
Dim IPic As IPicture

Const PICTYPE_BITMAP = 1

With IID_IDispatch
.Data1 =& H7BF80980
.Data2 =& HBF32
.Data3 =& H101A
.Data4(0 )=& H8B
.Data4(1)=& HBB
.Data4(2)=& H0
.Data4(3)=& HAA
.Data4 (4)=& H0
.Data4(5)=& H30
.Data4(6)=​​& HC
.Data4(7)=& HAB


结尾使用uPicInfo
.Size = Len(uPicInfo)
.Type = PICTYPE_BITMAP
.hPic = hPic
.hPal = 0
End With

OleCreatePictureIndirect uPicInfo,IID_IDispatch,True,IPic

设置ConvertToIPicture = IPic
End Function


但用黑色背景加载而不是透明的png图像?如何解决这个问题?


解决方案

我使用这个函数(注意函数可以在一个单独的模块中):



  Private Sub UserForm_Activate()
With Me.Image1
.BorderStyle = fmBorderStyleNone
.PictureSizeMode = fmPictureSizeModeZoom
.BackStyle = fmBackStyleTransparent
.Picture = LoadImage(“C:\images\MinersBag.png”)
End With
end sub


公共函数LoadImagePat(ByVal h $)作为IPicture'si LoadImage ne marche pas,您可以获得透明度:
'代码by lepelletier Patrick 28/02/2016

Dim Aff As Boolean b $ b Dim Pic As Shape
With Application
Aff = .ScreenUpdating
.ScreenUpdating = False
End With
Set Pic = ActiveSheet.Pictures 。插入(h).ShapeRange(1)
带图片
。复制
设置LoadImagePat = PastePicture
。删除

结束Set Pic = Nothing
如果Aff Then Application .ScreenUpdating = True
End Function


PastPicture 例程是由Stephen Bullen发现的,可以在这里直接下载链接)。在链接腐烂的情况下,这是 modPastePicture 的副本。将它全部保存到 modPastePicture.bas 中,然后将该文件导入到VBA编辑器中。

 属性VB_Name =“modPastePicture”
'*********************************** ****************************************
'*
'* MODULE NAME:Paste Picture
'* AUTHOR&日期:STEPHEN BULLEN,办公自动化有限公司
'* 1998年11月15日
'*
'*联系人:Stephen@oaltd.co.uk
'*网站:http:/ /www.oaltd.co.uk
'*
'*说明:根据剪贴板上的内容创建标准图片对象。
'*然后可以将该对象分配给用户窗体上的(例如)和图像控件
'*。 PastePicture函数接受一个可选的参数
'*图片类型 - xlBitmap或xlPicture。
'*
'*该代码需要引用“OLE自动化”类型库
'*
'*此模块中的代码来源于许多来源
'*在MSDN上发现。
'*
'*要使用它,只需将该模块复制到您的项目中,然后您可以使用:
'* Set Image1.Picture = PastePicture(xlPicture)
'*将任何剪贴板上的图片粘贴到标准图像控件中。
'*
'* PROCEDURES:
'* PastePicture例程的入口点
'* CreatePicture将位图或图元文件句柄转换为OLE引用的专用函数
'* fnOLEError获取OLE错误代码
'的错误文本******************************** *******************************************

选项显式
选项比较文本
$ b $'''API调用的用户定义类型

'声明UDT以存储IPicture OLE接口的GUID
私有类型GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7)As Byte
End Type

'声明一个UDT来存储位图信息
私有类型uPicDesc
大小As Long
类型As Long
hPic As Long
hPal As Long
结束类型
$ b $'''Windows API函数声明

'剪贴板是否包含位图/元文件?
Private Declare Function IsClipboardFormatAvailable Lib“user32”(ByVal wFormat As Integer)As Long

'打开剪贴板以读取
Private Declare Function OpenClipboard Lib“user32”(ByVal hwnd As Long)As Long

获取指向位图/元文件的指针
Private Declare Function GetClipboardData Lib“user32”(ByVal wFormat As Integer)As Long

'关闭剪贴板
Private Declare Function CloseClipboard Lib“user32”()As Long

'将句柄转换为OLE IPicture接口。
Private Declare Function OleCreatePictureIndirect Lib“olepro32.dll”(PicDesc As uPicDesc,RefIID As GUID,ByVal fPictureOwnsHandle As Long,IPic As IPicture)As Long
$ b $'创建我们自己的图元文件副本,所以它不会被随后的剪贴板更新消除。
声明函数CopyEnhMetaFile Lib“gdi32”Alias“CopyEnhMetaFileA”(ByVal hemfSrc As Long,ByVal lpszFile As String)As Long

'创建我们自己的位图副本,所以它没有被随后的剪贴板更新消灭。
声明函数CopyImage Lib“user32”(ByVal句柄As Long,ByVal un1 As Long,ByVal n1 As Long,ByVal n2 As Long,ByVal un2 As Long)As Long

'API我们感兴趣的格式类型
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const CF_ENHMETAFILE = 14
Const IMAGE_BITMAP = 0
Const LR_COPYRETURNORG =& H4

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' “”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“” ''''
'''子程序:PastePicture
'''
'''目的:获取一个画面对象,显示剪贴板上的内容。
'''
'''参数:lXlPicType - 要创建的图片类型。可以是下列之一:
'''xlPicture创建图元文件(默认)
'''xlBitmap创建位图
'''
'''Date开发者动作
'''-------------------------------------------- ------------------------------
'''98年10月30日Stephen Bullen创建
''' 15年11月15日Stephen Bullen更新后创建我们自己的剪贴板图像副本
'''

功能PastePicture(可选lXlPicType As Long = xlPicture)作为IPicture

'某些指针
Dim h As Long,hPicAvail As Long,hPtr As Long,hPal As Long,lPicType As Long,hCopy As Long

'将请求的类型从xl常量到API常量
lPicType = IIf(lXlPicType = xlBitmap,CF_BITMAP,CF_ENHMETAFILE)

检查剪贴板是否包含所需格式
hPicAvail = IsClipboardFormatAvailable(lPicType)

如果hPicAvail<> 0然后
'访问剪贴板
h = OpenClipboard(0&)

如果h> 0然后
'获取图像数据的句柄
hPtr = GetClipboardData(lPicType)

'以合适的格式在剪贴板上创建我们自己的图像副本。
如果lPicType = CF_BITMAP Then
hCopy = CopyImage(hPtr,IMAGE_BITMAP,0,0,LR_COPYRETURNORG)
else
hCopy = CopyEnhMetaFile(hPtr,vbNullString)
End If

'将剪贴板释放到其他程序
h = CloseClipboard

'如果我们得到了图像的句柄,将它转换成Picture对象并返回
如果hPtr<> 0然后设置PastePicture = CreatePicture(hCopy,0,lPicType)
End If
End If

End Function


''' “”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“” '''''''''''''''''''''''''''''''''''''''''$'$' ''子程序:CreatePicture
'''
'''目的:将图像(和调色板)句柄转换为图片对象。
'''
'''需要引用“OLE自动化”类型库
'''
'''参数:无
'''
'''日期开发人员操作
'''---------------------------------- ----------------------------------------
'''10月30日98 Stephen Bullen创建了
'''

私有函数CreatePicture(ByVal hPic As Long,ByVal hPal As Long,ByVal lPicType)作为IPicture

'IPicture需要引用to“OLE Automation”
Dim r As Long,uPicInfo As uPicDesc,IID_IDispatch As GUID,IPic As IPicture

'OLE图片类型
Const PICTYPE_BITMAP = 1
Const PICTYPE_ENHMETAFILE = 4

'创建接口GUID(对于IPicture接口)
使用IID_IDispatch
.Data1 =& H7BF80980
.Data2 =& HBF32
.Data3 =& H101A
.Data4(0)=& H8B
.Data4(1)=& HBB
.Data4(2)=& H0
.Data4(3)=& HAA
.Data4(4)=& H0
.Data4(5)=& H30
.Data4(6)= & HC
.Data4(7)=& HAB


结尾填写uPicInfo所需的部分。
使用uPicInfo
.Size = Len(uPicInfo)'结构的长度。
.Type = IIf(lPicType = CF_BITMAP,PICTYPE_BITMAP,PICTYPE_ENHMETAFILE)'图片类型
.hPic = hPic'处理图像。
.hPal = IIf(lPicType = CF_BITMAP,hPal,0)'处理到调色板(如果位图)。
End With

'创建图片对象。
r = OleCreatePictureIndirect(uPicInfo,IID_IDispatch,True,IPic)

'如果发生错误,则显示描述
如果r <0 Then Debug.Print“Create Picture:”& fnOLEError(r)

'返回新的图片对象。
Set CreatePicture = IPic

End Function

''''''''''''''''''''''''''''''''' “”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“”“” ''''''''''''''''''''''''''''''''$''''''''''''b'''''''获取标准OLE错误的消息文本
'''
'''参数:无
'''
'''日期开发者操作
''' - -------------------------------------------------- -----------------------
'''98年10月30日Stephen Bullen创建
'''

Private Function fnOLEError(lErrNum As Long)As String

'OLECreatePictureIndirect返回值
Const E_ABORT =& H80004004
Const E_ACCESSDENIED =& H80070005
Const E_FAIL = & H80004005
Const E_HANDLE =& H80070006
Const E_INVALIDARG =& H80070057
Const E_NOINTERFACE =& H80004002
Const E_NOTIMPL =& H80004001
Const E_OUTOFMEMORY =& H8007000E
Const E_POINTER =& H80004003
Const E_UNEXPECTED =& H8000FFFF
Const S_OK =& H0

选择案例lErrNum
案例E_ABORT
fnOLEError =“已中止“
案例E_ACCESSDENIED
fnOLEError =”访问被拒绝“
案例E_FAIL
fnOLEError =”常规故障“
案例E_HANDLE
fnOLEError =”错误/缺失处理“
案例E_INVALIDARG
fnOLEError =”无效参数“
案例E_NOINTERFACE
fnOLEError =”无界面“
案例E_NOTIMPL
fnOLEError =”未实施“
案例E_OUTOFMEMORY
fnOLEError =“内存不足”
案例E_POINTER
fnOLEError =“无效指针”
案例E_UNEXPECTED
fnOLEError =“未知错误”
案例S_OK
fnOLEError =“成功!”
结束选择

结束功能

本文地址:IT屋 » LoadImage PNG在excel vba中形成image1.picture控件,黑色背景

官方微信
扫一扫关注IT屋
微信公众号搜索 “ IT屋 ” ,选择关注
与百万开发者在一起