（Excel VBA）如果单元格值等于“”则显示/隐藏图像

Question

我正在研究Excel电子表格，当选择下拉框值时，将弹出一个图像，如果选择了另一个值，它将隐藏当前图像并弹出与选择相关的图像。我找到了一些方法，只使用工作表和使用坐标定位图像太费时间;这不是我想要的路线。在使用StackOverflow之前，我做了很多研究，到目前为止似乎没有任何工作。以下是我想要实现的目标。我试图将所有图像保留在电子表格中，这增加了另一层次的挑战，但我相信有一种方法可以做到这一点，因为excel会在插入 EX时为图像指定一个数字。图9 。

Sub Main()
   If Range(G11).Value = "anything" Then

   Picture1 show

   Picture2 hide

   End If
End Sub

非常感谢任何帮助。感谢

Answer 1

为什么不简单地删除它？而不是隐藏/移动/减少不需要的图片的大小？

<强>逻辑： 将所有图像保存在临时表中。当应该显示相关图片时，从临时表中获取并删除之前的图片。

这是一个例子。

Sub Sample()
    Select Case Range("G11").Value
        Case "Picture 1": ShowPicture ("Picture 1")
        Case "Picture 2": ShowPicture ("Picture 2")
        Case "Picture 3": ShowPicture ("Picture 3")
        Case "Picture 4": ShowPicture ("Picture 4")
    End Select
End Sub

Sub ShowPicture(picname As String)
    '~~> The reason why I am using OERN is because it is much simpler
    '~~> than looping all shapes and then deleting them. There could be
    '~~> charts, command buttons and other shapes. I will have to write
    '~~> extra validation code so that those shapes are not deleted.
    On Error Resume Next
    Sheets("Sheet1").Shapes("Picture 1").Delete
    Sheets("Sheet1").Shapes("Picture 2").Delete
    Sheets("Sheet1").Shapes("Picture 3").Delete
    Sheets("Sheet1").Shapes("Picture 4").Delete
    On Error GoTo 0

    Sheets("Temp").Shapes(picname).Copy

    '<~~ Alternative to the below line. You may re-position the image 
    '<~~ after you paste as per your requirement
    Sheets("Sheet1").Range("G15").Select 

    Sheets("Sheet1").Paste
End Sub

临时表的快照

Answer 2

这是使用对象的Visible属性的解决方案。 我用它来显示基于字段值的图片。 该领域的公式导致“好”或“坏”。 如果它的价值“好”，我想展示一张图片;对于“坏”，应该显示另一张图片;他们不应该同时出现。 每当用户刷新数据透视表时，该字段都需要更新其值，因此我将代码放在工作表的方法中，其中将显示数据透视表和图片。

{'id2': ['KMKMKMKMKM', 'KMKMKM'], 'id1': ['KMKMKMK']}

Answer 3

Sub hidePicture(myImage)
    ActiveSheet.Shapes.Range(Array(myImage)).Select
    Selection.ShapeRange.Height = 0
    Selection.ShapeRange.Width = 0
End Sub

Sub showPicture(myImage)
    ActiveSheet.Shapes.Range(Array(myImage)).Select
    Selection.ShapeRange.Height = 200
    Selection.ShapeRange.Width = 300
End Sub

方便提示：记录宏并查看它生成的代码！

Answer 4

最好将图片“移出屏幕”，特别是如果它们的尺寸不同。

Sub Tester()
    ShowPicture "Picture 3"
End Sub

Sub ShowPicture(PicName As String)

    Dim s As Shape
    For Each s In ActiveSheet.Shapes
        With s
        .Top = IIf(.Name = PicName, 100, 100)
        .Left = IIf(.Name = PicName, 100, 1000)
        End With
    Next s

End Sub