使用VBA来改变图片(Using VBA to change Picture)

我想使用VBA来自动更改图片的功能，当你右击在Excel /字/ PowerPoint中的形状。

但是，我无法找到任何引用，可以帮助？

Answer 1:

可以改变使用的图片的源UserPicture方法应用于矩形形状。 但是，您将需要相应地调整矩形的大小，如果你希望保持图片的原始宽高比，因为画面将采取矩形的尺寸。

举个例子：

 ActivePresentation.Slides(2).Shapes(shapeId).Fill.UserPicture ("C:\image.png")

Answer 2:

据我知道你不能更改图片的来源，你需要删除旧的并插入一个新的

这里是一个开始

strPic ="Picture Name"
Set shp = ws.Shapes(strPic)

'Capture properties of exisitng picture such as location and size
With shp
    t = .Top
    l = .Left
    h = .Height
    w = .Width
End With

ws.Shapes(strPic).Delete

Set shp = ws.Shapes.AddPicture("Y:\our\Picture\Path\And\File.Name", msoFalse, msoTrue, l, t, w, h)
shp.Name = strPic
shp.ScaleHeight Factor:=1, RelativeToOriginalSize:=msoTrue
shp.ScaleWidth Factor:=1, RelativeToOriginalSize:=msoTrue

Answer 3:

'change picture without change image size
Sub change_picture()
strPic = "Picture 1"
Set shp = Worksheets(1).Shapes(strPic)

'Capture properties of exisitng picture such as location and size
With shp
    t = .Top
    l = .Left
    h = .Height
    w = .Width
End With

Worksheets(1).Shapes(strPic).Delete

Set shp = Worksheets(1).Shapes.AddPicture("d:\pic\1.png", msoFalse, msoTrue, l, t, w, h)
shp.Name = strPic

End Sub

Answer 4:

在Word 2010中VBA它有助于改变你想改变的图像元素。可见选项。

1. 设置。可见为false
2. 更改图片
3. 设置.visilbe为真

这为我工作。

Answer 5:

我做的是对海誓山盟顶部放置两个图像，并分配到以下两个图像宏。 很显然，我已经命名的图像“lighton”和“起燃”，所以一定要改变你的图像。

Sub lightonoff()

If ActiveSheet.Shapes.Range(Array("lighton")).Visible = False Then
    ActiveSheet.Shapes.Range(Array("lighton")).Visible = True
        Else
    ActiveSheet.Shapes.Range(Array("lighton")).Visible = False
    End If

End Sub

Answer 6:

我已经在过去做的是在窗体上创建多个图像控制起来搁在彼此的顶部。 然后你编程设置的所有图像。可见=除非你想显示一个虚假的。

Answer 7:

我用这个代码：

Sub changePic(oshp As shape)
    Dim osld As Slide
    Set osld = oshp.Parent
    osld.Shapes("ltkGambar").Fill.UserPicture (ActivePresentation.Path & "\" & oshp.Name & ".png")
End Sub

Answer 8:

我在Excel和VBA工作。 我不能叠加图像，因为我有一个可变数目的多张纸和每一薄板上有图像，因此该文件将获得巨额如果说20张了所有5张图片我想动画。

所以我用这里列出这些技巧的组合：1）我插入一个长方形的位置和大小，我想：

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 1024#, 512#, 186#, 130#).Select
Selection.Name = "SCOTS_WIZARD"
With Selection.ShapeRange.Fill
  .Visible = msoTrue
  .UserPicture "G:\Users\ScotLouis\Documents\My Spreadsheets\WordFind Wizard\WordFind Wizard 1.jpg"
  .TextureTile = msoFalse
End With

2）我们动画（变化）的图片，我只需要改变Shape.Fill.UserPicture：

ActiveSheet.Shapes("SCOTS_WIZARD").Fill.UserPicture _
    "G:\Users\ScotLouis\Documents\My Spreadsheets\WordFind Wizard\WordFind Wizard 2.jpg"

所以，我已经完成了我的唯一具有每片1个画面目标（而不是5在我的动画），并复制表仅复制活动的画面，所以动画的下一个画面无缝继续。

Answer 9:

我试图模仿的“更改图片”用VBA在PowerPoint中的原有功能（PPT）

下面的代码尝试恢复后的原始图片的属性： - 。左，.TOP，.WIDTH，.Height - ZORDER - 形状名称 - 超链接/动作设置 - 动画效果

Option Explicit

Sub ChangePicture()

    Dim sld As Slide
    Dim pic As Shape, shp As Shape
    Dim x As Single, y As Single, w As Single, h As Single
    Dim PrevName As String
    Dim z As Long
    Dim actions As ActionSettings
    Dim HasAnim As Boolean
    Dim PictureFile As String
    Dim i As Long

    On Error GoTo ErrExit:
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then MsgBox "Select a picture first": Exit Sub
    Set pic = ActiveWindow.Selection.ShapeRange(1)
    On Error GoTo 0

    'Open FileDialog
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Picture File", "*.emf;*.jpg;*.png;*.gif;*.bmp"
        .InitialFileName = ActivePresentation.Path & "\"
        If .Show Then PictureFile = .SelectedItems(1) Else Exit Sub
    End With

    'save some properties of the original picture
    x = pic.Left
    y = pic.Top
    w = pic.Width
    h = pic.Height
    PrevName = pic.Name
    z = pic.ZOrderPosition
    Set actions = pic.ActionSettings    'Hyperlink and action settings
    Set sld = pic.Parent
    If Not sld.TimeLine.MainSequence.FindFirstAnimationFor(pic) Is Nothing Then
        pic.PickupAnimation 'animation effect <- only supported in ver 2010 above
        HasAnim = True
    End If

    'insert new picture on the slide
    Set shp = sld.Shapes.AddPicture(PictureFile, False, True, x, y)

    'recover original property
    With shp
        .Name = "Copied_ " & PrevName

        .LockAspectRatio = False
        .Width = w
        .Height = h

        If HasAnim Then .ApplyAnimation 'recover animation effects

        'recover shape order
        .ZOrder msoSendToBack
        While .ZOrderPosition < z
            .ZOrder msoBringForward
        Wend

        'recover actions
        For i = 1 To actions.Count
            .ActionSettings(i).action = actions(i).action
            .ActionSettings(i).Run = actions(i).Run
            .ActionSettings(i).Hyperlink.Address = actions(i).Hyperlink.Address
            .ActionSettings(i).Hyperlink.SubAddress = actions(i).Hyperlink.SubAddress
        Next i

    End With

    'delete the old one
    pic.Delete
    shp.Name = Mid(shp.Name, 8)  'recover name

ErrExit:
    Set shp = Nothing
    Set pic = Nothing
    Set sld = Nothing

End Sub

使用方法：建议你到这个宏添加到快速访问工具栏列表。 （转到选项或功能区菜单上单击鼠标右键））首先，选择您想要更改幻灯片上的图片。 然后，如果FileDialog的窗口打开时，选择一个新的图片。 完成。 通过使用这种方法，你可以当你想更改图片绕过版本2016年“Bing搜索和一个驱动器窗口”。

在代码中，有可能（也应该）会有一些错误或缺少些什么。 我会很感激，如果有人或任何主持人纠正代码中的这些错误。 但总的来说，我发现它工作正常。 另外，我承认，仍然有原始形状的多个属性恢复 - 如形状，透明度，pictureformat等的行属性。 我想这可能是谁想要复制的形状的那些TOO MANY性质的人开始。 我希望这是有帮助的人。

文章来源: Using VBA to change Picture