根据单元格值返回图像(100个图像和可变单元格) [英] Return images based on cell value (100 images and variable cells)

问题描述

我正在尝试为我制作TFT(队战战术)表，并希望使其看起来更好.为此，我想添加游戏中冠军的图像.输入名称时，图像应显示在下方.我找到了一种将所有图像插入excel工作表(〜100)的方法，并且还成功制作了一个动态图像:

I'm trying to make a TFT (Teamfight Tactics) sheet for me and wanted to make it look better. To do this I wanted to add images of the champions from the game. The image should appear below when I'm entering the name. I've found a way to insert all images into the excel sheet (~100) and also successfully made one dynamic image:

= insertIMG:

=insertIMG:

=INDEX(PIC!$B$1:$B$55;MATCH(Sheet1!B4;PIC!$A$1:$A$55;0))

我尝试将 Sheet1！B4 部分变量设置为变量，但它不适用于单元格D5.对我而言，目前唯一的解决方案是为每个插槽"创建一个名称"范围，但这将花费大量时间.是否可以通过输入名称使excel在下面插入图像?

I tried to make the Sheet1!B4 part variable but it doens't work for the cell D5. The only solution right now for me would be to make a Name range for every "slot", but this would take a huge amount of time. Is there a way to make excel insert images below just by entering the name?

推荐答案

Y 您可以使用Worksheet_Change事件来实现所需的目标.

You can achieve what you want using the Worksheet_Change event.

出于演示目的，我将使用3个单元格B4，C4和D4

For demonstration purpose, I am going to take 3 cells B4, C4 and D4

假设我们的图片表(我们称其为PIC)看起来像这样.

Let's say our images sheet (Let's call it PIC) looks like this.

如果您注意到，我在第二行中插入了空白形状.如果用户在B4，C4或D4中按Delete键，我们将使用此形状.如果找不到匹配项，我们还将使用此图片.

If you notice, I have inserted a blank shape in the 2nd row. We will use this shape if user presses delete in B4, C4 or D4. We will also use this image if there is no match found.

现在让我们准备我们的主要工作表.请按照以下步骤操作

Now let's prepare our main worksheet. Follow these steps

1. 在PIC工作表中选择单元格B2(而不是形状)，然后按 CRTL + C .
2. 右键单击主表中的单元格B5，然后单击Paste Special-->Linked Picture，如下所示.
3. 重复单元格C5和D5.您的工作表现在看起来像这样.
4. 我们现在已经准备好基本设置.打开VBE并将以下代码粘贴到工作表代码区域中，我们就完成了！

1. Select cell B2(and not the shape) in the PIC sheet and press CRTL + C.
2. Right click on the cell B5 in the main sheet and click on Paste Special-->Linked Picture as shown below.
3. Repeat for Cell C5 and D5. Your worksheet now looks like this.
4. We are now ready with the basic setup. Open VBE and paste the below code in the worksheet code area and we are done!

代码:

Option Explicit

'More about Worksheet_Change at the below link
'https://stackoverflow.com/questions/13860894/why-ms-excel-crashes-and-closes-during-worksheet-change-sub-procedure/13861640#13861640

Private Sub Worksheet_Change(ByVal Target As Range)
    '~~> Check if multiple cells were changed
    If Target.Cells.CountLarge > 1 Then Exit Sub

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Range("B4:D4")) Is Nothing Then
        Dim wsPic As Worksheet
        Dim pic As Shape, txtShp As Shape, shp As Shape
        Dim addr As String
        Dim aCell As Range

        '~~> Identify the shape below the changed cell
        For Each shp In ActiveSheet.Shapes
            If shp.TopLeftCell.Address = Target.Offset(1).Address Then
                Set txtShp = shp
                Exit For
            End If
        Next shp

        Set wsPic = ThisWorkbook.Sheets("PIC")

        '~~> Find the text in the PIC sheet
        Set aCell = wsPic.Columns(1).Find(What:=Target.Value2, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

        '~~> Identify the shape
        If Not aCell Is Nothing Then
            For Each shp In wsPic.Shapes
                If shp.TopLeftCell.Address = aCell.Offset(, 1).Address Then
                    Set pic = shp
                    addr = aCell.Offset(, 1).Address
                    Exit For
                End If
            Next shp
        End If

        '~~> Add the formula to show the image
        If Not pic Is Nothing And Not txtShp Is Nothing Then
            txtShp.Select '<~~ Required to insert the formula
            Selection.Formula = "=PIC!" & addr
        Else
            txtShp.Select
            Selection.Formula = "=PIC!$B$2"
        End If
        Target.Select '<~~ Remove focus from the shape
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

实际操作

示例文件

您可以从此处

这篇关于根据单元格值返回图像(100个图像和可变单元格)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！