Excel 2010 vba图像标志交换开关
将多个徽标图像（大小相似）插入到资源表中。 需要一种让用户轻松select他们想要的公司的方法，并将该标识replace为几张纸的左上angular的默认标识。
想要使用下拉菜单，以前dynamic使用过，效果很好。 下拉菜单可以放在用户窗体中，也可以放在仪表板上。 我已经看过堆叠的标志，并尝试一个Z轴开关，但Excel似乎并不支持这一点。 我也试过了.Replace和.Copy。
此外，徽标已经粘贴到隐藏的资源表中，因此我不希望用户search图像目录，也不需要依赖互联网连接来获取图像（它们有时会脱机工作）。 一个默认的图像已经放置在左上angular，只需要一种方法来匹配他们（文本）的公司select到相应的标志图像/名称，然后切换旧的标志与新指定的几个页面，在相同的左上angular。
编辑：
这是我迄今为止所尝试过的一个混杂模式，在不同的时间里，各种各样的线条都没有注释，而在这一点上，一些线条的方式真的没有意义。 只有张贴街道的信誉，我猜。 我只是试图找出一个小小的function，而不是要求任何人为我写程序（这是一个很大的差别）：
Private Sub CompanySelectComboBox_Change() If CompanySelectComboBox.Value <> "Select a company" Then ' select logo here Sheets(Sheets("TaskNew").Index + TaskSheetsComboBox.ListIndex + 1).Activate 'Private Sub TaskSheetsComboBox_Click() 'If TaskSheetsComboBox.Value <> "Go directly to a yellow task sheet" Then ' Sheets(Sheets("TaskNew").Index + TaskSheetsComboBox.ListIndex + 1).Activate 'End If 'End Sub MsgBox CompanySelectComboBox.Value MsgBox CompanySelectComboBox.ListIndex Image("Logo").Replace Image("Logo"), Sheets("Config").Image("Logo2") 'Logo.Select ' another possibility: ' LogoPic.Picture = LoadPicture(Fname) ' another possibility: 'Sheets("Configs").Image("Logo").Copy Before:=Sheets("TaskEnd") ' another possibility: 'CodeNames of Sheets 'Sheets("Configs").Shapes("Picture 1").Copy 'Sheets("Dashboard").Range("A1").PasteSpecial Else ' user didn't select a company, so just keep default (Generic) for now End If End Sub 那么，你的解释后，我改变-1到+1。 让我们把问题分解成几部分。
首先，在您的资源表中，将图片放在B列中。在A列中给每张图片（公司名称）。您可以调整行高，使每张图片适合自己的行。
那么这是一个例子，你如何将这些名字与这些图片联系起来：
Dim sh As Worksheet, pic As Shape Set sh = ThisWorkbook.Worksheets("Pictures") For Each pic In sh.Shapes If pic.Type = msoPicture Then Debug.Print pic.TopLeftCell.Cells(1, 0) ' print the company name End If Next
现在，您可以从中创build一个combobox或用户对话框，向用户询问他想要的公司，并让他select一个名称。 这里是一个示例函数，将给定名称的图片复制到剪贴板：
Function CopyLogoToClipboard(picName As String) As Boolean Dim sh As Worksheet, pic As Shape Set sh = ThisWorkbook.Worksheets("Pictures") For Each pic In sh.Shapes If pic.Type = msoPicture And pic.TopLeftCell.Cells(1, 0) = picName Then pic.Copy CopyLogoToClipboard = True Exit Function End If Next CopyLogoToClipboard = False End Function
（不要忘了使用它时检查返回值）。
现在，最后一部分是将徽标插入到您想要的地方。 例如，将其放在活动工作表的左上angular：
ActiveSheet.Paste Set pic = Selection.ShapeRange(1) pic.Top = 0 pic.Left = 0
希望这可以帮助。