Image 根据IF公式调用图片的VBA代码

我在第1页上有一个表格，有多个单元格（B7:L7、B11:L11和B13:L13），在一张单独的表格上有3-4张不同的图片（第2页）。我正试图根据它们的值为每个单元格调用不同的图片（即，如果单元格=2，它们应该显示另一张表中的一张图片，如果单元格=3，它们应该显示不同的图片，等等）

我已经尝试了100种不同的方法，并不断地进行删减，因此任何输入都将不胜感激

编辑：包括代码- 就像我说的，我用了大约100种不同的方法。这是我最近的一次尝试。虽然可能比必要的更笨重，但它对一个单元格非常有效，我只是不知道如何编辑它以使其适用于整个范围（除了对每个单元格分别进行复制和粘贴）。我还想添加一些东西使其在单元格中居中，但也没有成功

Sub InsertPicture()
Dim PicCell As Range

Set PicCell = Range("B7")

If PicCell = 2 Then
    Worksheets("Sheet2").Activate
    ActiveSheet.Shapes.Range(Array("Picture2")).Select
    Selection.Copy
    Worksheets("Sheet1").Activate
    Range("B7").Select
    Sheets("Sheet1").Pictures.Paste
ElseIf PicCell = 3 Then
    Worksheets("Sheet2").Activate
    ActiveSheet.Shapes.Range(Array("Picture3")).Select
    Selection.Copy
    Worksheets("Sheet1").Activate
    Range("B7").Select
    Sheets("Sheet1").Pictures.Paste
ElseIf PicCell = 4 Then
    Worksheets("Sheet2").Activate
    ActiveSheet.Shapes.Range(Array("Picture4")).Select
    Selection.Copy
    Worksheets("Sheet1").Activate
    Range("B7").Select
    Sheets("Sheet1").Pictures.Paste
ElseIf PicCell = 5 Then
    Worksheets("Sheet2").Activate
    ActiveSheet.Shapes.Range(Array("Picture5")).Select
    Selection.Copy
    Worksheets("Sheet1").Activate
    Range("B7").Select
    Sheets("Sheet1").Pictures.Paste
ElseIf PicCell = 6 Then
    Worksheets("Sheet2").Activate
    ActiveSheet.Shapes.Range(Array("Picture6")).Select
    Selection.Copy
    Worksheets("Sheet1").Activate
    Range("B7").Select
    Sheets("Sheet1").Pictures.Paste
Else: MsgBox ("No picture at this time")
End If

---

让我们从这个开始，看看我们是否接近你想要的

我的Sheet1如下所示：

Sheet2的图像如下所示：

---

代码：（简化和改进，但无错误检查）

---

结果见表1：

---

请包括您的示例代码并突出显示问题部分。最诚挚的问候，考虑添加代码，所以我们可以帮助你很多Easiel刚才添加代码！我不知道该补充什么，因为我已经尝试过很多次了。我现在已经包括了最新的版本。你所说的“整个范围”到底是什么意思？现在一切都在B7中，这会如何改变。。。逻辑是什么？我想这是我的问题。我正在试图找出如何重新编写它，以便它可以在B7:L7、B11:L11和B13:L13上工作，而不仅仅是B7。

Sub InsertPicture()
    Dim PicSht As Worksheet
    Set PicSht = Worksheets("Sheet2")

    Dim mySheet As Worksheet
    Set mySheet = Worksheets("Sheet1")

    Dim cell As Range

    For Each cell In mySheet.Range("B7:L7")
        Select Case cell
            Case 2 To 6
                PicSht.Shapes("Picture" & cell.Value).Copy
                cell.Select
                mySheet.Pictures.Paste

            Case Else
                MsgBox ("No picture at this time")
        End Select
    Next cell
End Sub