プロが教えるわが家の防犯対策術!

Excel2010にて、 VBA マクロ 画像(図)貼り付けを行いたいと思っています。
しかし、マクロを自動登録すると、ActiveSheet.Pictures.Paste.Selectになり、AddPicture ができません。 下記のマクロをAddPictureへ変換したいのですが、そのまま、InsertをAddpictureに変更してもエラーになってしまいます。 いい方法を教えてください(ToT)/~~~。 どうぞよろしくお願いします。

Sub Test()
'
' Test Macro
'
Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.RowHeight = 150#

Range("C4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileC.gif"").Select
ActiveSheet.Pictures.Paste.Select
Range("D4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileD.gif"").Select
Selection.Cut
Range("D4").Select
ActiveSheet.Pictures.Paste.Select
Range("E4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileE.gif"").Select
Range("E4").Select
ActiveSheet.Pictures.Paste.Select
Range("F4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileE.gif"").Select
ActiveSheet.Pictures.Paste.Select
Range("G4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileG.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("H4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileH.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("I3").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileI.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("J4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileJ.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("K3").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileK.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("L3").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileL.gif"").Select
ActiveSheet.Pictures.Paste.Select
Range("M4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileM.gif"").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
Range("N4").Select
ActiveSheet.Pictures.Insert( _
"E:\FolderA\fileN.gif").Select
Selection.Cut
ActiveSheet.Pictures.Paste.Select
End Sub

A 回答 (2件)

ファイル名が fileC.gif~fileN なら


Sub Test()
  Dim c As Range
  Dim myPath As String
  Dim FileName As String

  Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Selection.RowHeight = 150#
  myPath = "E:\FolderA\"
  For Each c In Range("C4:N4")
    FileName = "file" & Left(c.Address(0, 0), 1) & ".gif"
    With ActiveSheet.Shapes.AddPicture( _
      FileName:=myPath & FileName, _
      LinkToFile:=True, _
      SaveWithDocument:=False, _
      Left:=0, Top:=0, Width:=0, Height:=0)
      .ScaleHeight 1!, True
      .ScaleWidth 1!, True
      .LockAspectRatio = True
      .Locked = False
      .Left = c.Left
      .Top = c.Top
    End With
  Next
End Sub
    • good
    • 0

このようにします。


Range("C4").Select
ActiveSheet.Shapes.AddPicture "E:\FolderA\fileC.gif", False, True, Range("C4").Left, Range("C4").Top, 200, 150

ActiveSheet.Pictures.Paste.Select
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!