Question

在资源表上插入了几个徽标图像（大小相似）。需要一种方法让用户轻松选择他们想要的公司，并让该徽标替换几张纸左上角的默认徽标。

想要使用下拉菜单，之前已动态使用，效果很好。下拉列表可以位于用户表单中，也可以位于仪表板上。我已经看起来像堆叠徽标和尝试z轴切换，但Excel似乎不支持这一点。我也试过.Replace和.Copy。

同样，徽标已粘贴到隐藏的资源表中，因此我不希望用户搜索图像目录，也不希望依赖互联网连接来获取图像（它们有时会脱机工作）。一个默认图像已经放置在左上角，只需要一种方法将他们的（文本）公司选择与相应的徽标图像/名称相匹配，然后在我指定的几个页面上用新的切换旧徽标，同样左上角。

编辑：

这是我到目前为止尝试过的一个混搭，各种各样的线条在不同的时间都没有注释，而且在这一点上，某些线条在它呈现的方式上真的没有意义。我想只发布街头信誉。我只是想弄清楚一个小小的特征，而不是让任何人为我编写我的程序（这是范围上的一个很大的区别）：

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

Answer 1

尝试

http://www.officevb.com/2009/11/utilizando-o-procv-com-imagens.html

Answer 2

好吧，在你的解释之后我把-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

现在，您可以从中创建一个组合框或用户对话框，询问用户他想要哪个公司并让他选择一个名称。以下是将给定名称的图片复制到剪贴板的示例函数：

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

（不要忘记在使用时检查返回值）。

现在，最后一部分是将徽标插入您想要的地方。例如，将其放在活动工作表的左上角：

ActiveSheet.Paste
Set pic = Selection.ShapeRange(1)
pic.Top = 0
pic.Left = 0

希望这有帮助。

excel 2010 vba图像标识交换开关

2 个答案: