web-dev-qa-db-ja.com

VBAを使用して画像を変更する

Excel/Word/PowerPointで図形を右クリックすると、VBAを使用して画像の変更機能を自動化しようとしています。

しかし、私は参考文献を見つけることができません、あなたは援助できますか？

imagevbams-officeexcel-2007
12
PlayKid

長方形の形状に適用される serPicture メソッドを使用して、画像のソースを変更できます。ただし、画像は長方形のサイズをとるため、画像の元のアスペクト比を維持したい場合は、それに応じて長方形のサイズを変更する必要があります。

例として：

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

変更画像のソースを変更できないことがわかっている限り、古い画像を削除して新しい画像を挿入する必要があります

はじめに

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
8
chris neilsen
'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
2
ali-mousavi

私がしていることは、両方の画像を重ね合わせ、下のマクロを両方の画像に割り当てることです。明らかに私は「lighton」と「lightoff」という画像に名前を付けたので、それをあなたの画像に変更することを確認してください。

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
1
user5847966

Word 2010 VBAでは、変更する画像要素の.visibleオプションを変更すると便利です。

  1. .visibleをfalseに設定します
  2. 写真を変える
  3. .visilbeをtrueに設定します

それは私のために働いた。

1
user5326408

私が過去にやったことは、フォーム上にいくつかの画像コントロールを作成し、それらを互いの上に配置することです。次に、表示したいものを除いて、すべての画像を.visible = falseにプログラムで設定します。

0
user4024676

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つではない）の目標を達成し、シートを複製するとアクティブな画像のみが複製されるため、アニメーションは次の画像とシームレスに続きます。

0
user3422093

私はこのコードを使用します：

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
0
Yeera

PowerPoint（PPT）でVBAを使って「写真を変える」の本来の機能を真似てみました

以下のコードは、元の画像の次のプロパティを回復しようとします：-.Left、.Top、.Width、.Height-zOrder-シェイプ名-HyperLink /アクション設定-アニメーション効果

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ウィンドウが開いたら、新しい画像を選択します。終わった。この方法を使用すると、画像を変更したい場合、ver 2016で「Bing検索とワンドライブウィンドウ」をバイパスできます。

コードには、いくつかの間違いや欠けているものがあるかもしれません（またはすべきです）。誰かまたはモデレーターがコード内のこれらのエラーを修正してくれれば幸いです。しかし、ほとんどの場合、問題なく動作することがわかりました。また、元の形状には回復するプロパティがまだまだあることを認めます。たとえば、形状の線のプロパティ、透明度、pictureformatなどです。これは、形状の非常に多くのプロパティを複製したい人にとっては、最初の1つになると思います。これが誰かのお役に立てば幸いです。

0
konahn

！[添付コードを見つけてください。最初にPPTで形状を作成し、コードを実行します]1

0
Tarun Reddy