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

Question

我正在寻找 VBA 代码，该代码将通过单击形状来循环显示形状中显示的背景图像（保存在我的计算机上）。

我找到了两组代码，给了我一个良好的开端，但我不知道如何合并代码以获得我正在寻找的结果。

我希望每次单击形状时都可以继续循环执行以下命令：

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

Answer 2

您可以使用代码：删除背景图像/图片作为使用工具图片格式 - >在Excel中设置透明颜色。

 Sub RemoveBackground()
   Dim selectedPicture As Picture
    Set selectedPicture = ActiveSheet.Pictures("Picture 3")
 ' Set the transparent color of the picture
    With selectedPicture.ShapeRange.PictureFormat
        .TransparentBackground = True
        .TransparencyColor = RGB(255, 255, 255)
    End With 
End Sub

==================

    Sub RemoveShapes()
    ' Select the image you want to remove the background from
    Dim selectedImage As Shape
    Set selectedImage = ActiveSheet.Shapes("Image1")     ' Set the transparent color of the image 

    With selectedImage.PictureFormat
        .TransparentBackground = msoTrue
        .TransparencyColor = RGB(255, 255, 255)
    End With
  End Sub  

谢谢你