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

Question

首次发布以获得一些详尽搜索后找不到的帮助。我相信这对于知道自己在做什么的人来说很容易。

我正在寻找可通过单击形状在形状中循环浏览（保存在计算机中的）背景图像的VBA。我在下面粘贴了两套代码，这为我提供了一个良好的开端，但我不知道如何合并代码以获取所需的结果。

最终，我希望每次单击形状都可以通过以下命令保持循环：

1. 初始形状：透明背景
2. 单击“形状”：将透明背景替换为BackgroundImage1
3. 另一次单击Shape：BackgroundImage1替换为BackgroundImage2
4. 另一次单击Shape：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