Excel VBA 通过单击形状更改形状的背景图像

Question

第一次发帖寻求一些我在穷尽搜索后找不到的帮助。我相信对于知道自己在做什么的人来说这很容易。

我正在寻找 VBA，它可以通过单击形状在形状内循环显示背景图像（保存在我的计算机上）。我在下面粘贴了 2 组代码，我发现它们给了我一个良好的开端，但我不知道如何合并代码以获得我正在寻找的结果。

最终，我希望每次点击一个形状时，通过以下命令继续循环：

初始形状：透明背景
单击形状：透明背景替换为 BackgroundImage1
再次单击形状：BackgroundImage1 替换为 BackgroundImage2
再次单击形状：BackgroundImage2 替换为透明背景

我发现这段代码可以很好地通过单击来更改形状的颜色：

Sub trafficlight()
Dim WhoAmI As String, sh As Shape
    WhoAmI = Application.Caller
    With ActiveSheet.Shapes(WhoAmI).Fill.ForeColor
        Select Case .RGB
            Case vbRed
                .RGB = vbGreen
            Case vbGreen
                .RGB = vbYellow
            Case Else
                .RGB = vbRed
        End Select
    End With
End Sub

然后使用保存在我计算机上的图像更改形状的代码：

Sub Rectangle9_Click()
Dim WhoAmI As String, sh As Shape
    WhoAmI = Application.Caller
    With ActiveSheet.Shapes(WhoAmI).Fill
        .Visible = msoTrue
        .UserPicture "C:\Users\username\Desktop\BackgroundImage1.png"
        .TextureTile = msoFalse
    End With
End Sub

希望这很容易理解。在此先感谢您的帮助！！！

Answer 1

您需要跟踪当前显示的图像。您可以为每次图像更改设置一个 integer。

Option Explicit

Sub ChangeShapePic()
Static i As Integer

With ActiveSheet.Shapes(Application.Caller).Fill
    Select Case i
        Case 0
            .UserPicture ("C:\Users\username\Desktop\BackgroundImage1.png")
            i = 1
        Case 1
            .UserPicture ("C:\Users\username\Desktop\BackgroundImage2.png")
            i = 2
        Case 2
            .UserPicture ("C:\Users\username\Desktop\BackgroundImage3.png")
            i = 3
        Case 3
           .Solid
           .Transparency = 0#
            i = 0
    End Select
End With
End Sub

Excel VBA 通过单击形状更改形状的背景图像

Excel VBA to change background image of shape by clicking on shape

excel

vba

if-statement

shapes

select-case