我想知道是否可以在 Excel 用户窗体上显示下面的图像（圆形）：
Picture http://im82.gulfup.com/E7phxt.png
或者至少我想显示以保持图像的透明度，因为看起来相框不接受 PNG 格式。
Userform http://im75.gulfup.com/LJj6ES.png
我的第二个也是更大的问题是我想直接从 excel 工作表 "Sheet1" 将图像加载到用户窗体中，我将插入的图像命名为：usflag、canadaflag、墨西哥国旗等......
Excel http://im75.gulfup.com/1uJ8cg.png
这样做的原因是工作表将被共享，我不想将图片路径链接到必须与工作表一起共享的特定文件夹。
我们将不胜感激。
【问题讨论】：
我有这样的解决方案。表单中的图像背景并不是真正透明的。 Excel 工作表中的图像是具有透明背景的 PNG，位于彩色 Excel 单元格填充上，然后被复制到用户表单中。这里是：
Picture 1 更改为 SelectedFlag
PictureSource
PictureSource 的引用，例如当国家/地区字段具有特定值时。测试这是否有效，即如果您运行 VBA 或更改特定单元格值，SelectedFlag 中显示的图像会发生变化。Image1 这是我使用的代码
Private Sub UserForm_Initialize()
Worksheets("TheHiddenSheet").Shapes("SelectedFlag").Copy
Set Image1.Picture = PastePicture()
End Sub
PastePicture() 命令不是本机 Excel 函数，而是 Steve Bullen 的一段代码。您需要创建一个常规模块并将以下代码粘贴到那里：
'*--------------------------------
'*
'* 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
'*
'* The 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 the GUID Type structure 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 the Picture Description Type structure
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long 'Holds the handle to a .bmp, .emf, .ico, .wmf file
Data1 As Long 'For a .bmp this holds the pallete handle hPal. For a .wmf this hold the xExt value.
Data2 As Long 'Used only with a .wmf to hold the yExt value.
End Type
'----------------------------
' Windows API Function Declarations '
'----------------------------
'Does the clipboard contain a bitmap/metafile?
Private Declare Function IsClipboardFormatAvailable _
Lib "user32.dll" _
(ByVal wFormat As Integer) _
As Long
'Open the clipboard to read and write data
Private Declare Function OpenClipboard _
Lib "user32.dll" _
(ByVal hWnd As Long) _
As Long
'Get a pointer to the bitmap/metafile
Private Declare Function GetClipboardData _
Lib "user32.dll" _
(ByVal wFormat As Integer) _
As Long
'Copy data to the clipboard
Private Declare Function SetClipboardData _
Lib "user32.dll" _
(ByVal uFormat As Long, _
ByVal hData As Long) _
As Long
'Empty the clipboard
Private Declare Function EmptyClipboard _
Lib "user32.dll" () As Long
'Close the clipboard
Private Declare Function CloseClipboard _
Lib "user32.dll" () As Long
'Convert the handle into an OLE IPicture interface.
Private Declare Function OleCreatePictureIndirect _
Lib "olepro32.dll" _
(ByRef pPictDesc As PICTDESC, _
ByRef riid As GUID, _
ByVal fOwn As Long, _
ByRef ppvObj 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.dll" 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.dll" _
(ByVal hImage As Long, _
ByVal uType As Long, _
ByVal cxDesired As Long, _
ByVal cyDesired As Long, _
ByVal fuFlags As Long) _
As Long
'The API Constants needed
Const CF_BITMAP = &H2
Const CF_ENHMETAFILE = &HE
Const CF_METAFILEPICT = &H3
Const CF_PALETTE = &H9
Const IMAGE_BITMAP = &H0
Const IMAGE_ICON = &H1
Const IMAGE_CURSOR = &H2
Const LR_COPYRETURNORG = &H4
Public Function PastePicture(Optional xlPicType As Long = xlPicture) As IPicture
'Some pointers
Dim hClip As Long
Dim hCopy As Long
Dim hObj As Long
Dim hPal As Long
Dim hPicAvail As Long
Dim PicType As Long
Dim RetVal As Long
'Convert the Excel picture type constant to the correct API constant
PicType = IIf(xlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)
'Check if the clipboard contains the required format
hPicAvail = IsClipboardFormatAvailable(PicType)
If hPicAvail <> 0 Then
'Get access to the clipboard
hClip = OpenClipboard(0&)
If hClip > 0 Then
'Get a handle to the object
hObj = GetClipboardData(PicType)
'Create a copy of the clipboard image in the appropriate format.
If PicType = CF_BITMAP Then
hCopy = CopyImage(hObj, IMAGE_BITMAP, 0&, 0&, LR_COPYRETURNORG)
Else
hCopy = CopyEnhMetaFile(hObj, vbNullString)
End If
'Release the clipboard to other programs
RetVal = CloseClipboard
'If there is a handle to the image, convert it into a Picture object and return it
If hObj <> 0 Then Set PastePicture = CreatePicture(hCopy, 0, PicType)
End If
End If
End Function
Private Function CreatePicture(ByVal hPic As Long, ByVal hPal As Long, ByVal PicType) As IPicture
'IPicture requires a reference to "OLE Automation"
Dim Ref_ID As GUID
Dim IPic As IPicture
Dim PicInfo As PICTDESC
Dim RetVal As Long
'OLE Picture types
Const PICTYPE_UNINITIALIZED = -1
Const PICTYPE_NONE = 0
Const PICTYPE_BITMAP = 1
Const PICTYPE_METAFILE = 2
Const PICTYPE_ICON = 3
Const PICTYPE_ENHMETAFILE = 4
'Create a UDT to hold the reference to the interface ID (riid).
'IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
'StdPicture GUID {0BE35204-8F91-11CE-9DE3-00AA004BB851}
With Ref_ID
.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 PicInfo structure
With PicInfo
.Size = Len(PicInfo) ' Length of structure.
.Type = IIf(PicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE) ' Type of Picture
.hPic = hPic ' Handle to image.
.Data1 = IIf(PicType = CF_BITMAP, hPal, 0&) ' Handle to palette (if bitmap).
.Data2 = 0&
End With
'Create the Picture object.
RetVal = OleCreatePictureIndirect(PicInfo, Ref_ID, True, IPic)
'Check if an error ocurred
If RetVal <> 0 Then
MsgBox "Create Picture Failed - " & GetErrMsg(RetVal)
Set IPic = Nothing
Exit Function
End If
'Return the new Picture object.
Set CreatePicture = IPic
End Function
Private Function GetErrMsg(ErrNum 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
Select Case ErrNum
Case E_ABORT
GetErrMsg = " Aborted"
Case E_ACCESSDENIED
GetErrMsg = " Access Denied"
Case E_FAIL
GetErrMsg = " General Failure"
Case E_HANDLE
GetErrMsg = " Bad/Missing Handle"
Case E_INVALIDARG
GetErrMsg = " Invalid Argument"
Case E_NOINTERFACE
GetErrMsg = " No Interface"
Case E_NOTIMPL
GetErrMsg = " Not Implemented"
Case E_OUTOFMEMORY
GetErrMsg = " Out of Memory"
Case E_POINTER
GetErrMsg = " Invalid Pointer"
Case E_UNEXPECTED
GetErrMsg = " Unknown Error"
End Select
End Function
您需要建立某种逻辑来确定应显示哪个标志/图片。假设您在工作表的单元格 A1 中存储国家/地区的名称，即美国、加拿大、阿根廷或墨西哥。
确保您的所有旗帜图片都位于单元格背景上，您需要选择的范围以捕获图片的大小始终相同。现在，选择包含美国国旗的范围并将其命名为“美国”。选择包含加拿大国旗的范围并将其指定为范围名称“加拿大”。冲洗并重复阿根廷和墨西哥。
所以现在，您有四个范围名称，每个标志一个。根据单元格 A1 的值，您现在可以更改“SelectedFlag”图像中显示的图片。请记住，此图像链接到名为“PictureSource”的命名范围。您现在可以重新定义该范围的参考并使其动态化。
编辑命名范围 PictureSource 并将其定义更改为
=INDIRECT(Sheet1!$A$1)
这当然要求 A1 中的值和命名范围完全匹配。每当 A1 中的值发生变化时，动态图像也会发生变化。这是具有三个不同图像的此类场景的屏幕截图。
因此，在加载表单之前或加载表单时，您需要进行一些活动，将单元格 A1 设置为所需的国家/地区名称。
【讨论】：
没关系，我想通了。
由于 Excel VBA 不允许我导入没有背景的 PNG 图像看起来像圆形，我只是在 Photoshop 中编辑了背景颜色以匹配用户界面的颜色。
现在，一旦我导入它，图像背景似乎是透明的，因此看起来是圆形的。
【讨论】：