【VBA】Excel2016で画像を一括挿入した時に画像情報を埋め込みたい

Windows7でExcel2003をずっと使用していたのですが、Windows10にしてからExcelも2016になりました。
今までVBAを使用して複数の画像を一括で貼り付けていたのですが、Excel2016で貼り付けると画像が埋め込みではなく外部からのリンク画像を表示した状態になります。
この画像をどのPCでも見れるように埋め込みにするには、Pictures.InsertをAddpictureメソッドに変更してLinkToFile:=Falseと明示するところまではたどり着いたのですが、引数の型が一致しません等のエラーが出るばかりで何が間違っているのかを教えていただきたいです。

VBAは少し勉強した程度で本当に初歩的な事しか出来ないです。
昔いた社員が作成したらしいのですが今は分かる者がおらず困っている状況です。
よろしくお願いします。

【いじってみたVBA】
Sub 複数の画像を挿入()

Application.ScreenUpdating = False
Dim StartRow
Dim StartCol
Dim LastObjRow
Dim EndRow As Long
Dim shp As Shape
StartRow = ActiveCell.Row
StartCol = ActiveCell.Column

For Each shp In ActiveSheet.Shapes
EndRow = Application.Max(EndRow, shp.BottomRightCell.Row)
Next

If StartCol = 1 Or StartCol = 6 Then
If StartRow < EndRow Then
If (StartRow - 4) Mod 14 = 0 Then
Else
MsgBox "有効なPhotoセルを選択して下さい"
Exit Sub
End If

ElseIf StartRow = EndRow And StartCol = 1 Then
Call PictFormCopiPe
ActiveCell.Offset(1, 0).Select
Else
MsgBox "写真を追加するときはA列の最後の罫線の下のセルを選択して下さい"
Exit Sub
End If
Else
MsgBox "A列かF列を選択して下さい。"
Exit Sub
End If

Dim strFilter As String
Dim Filenames As Variant
Dim PIC As Picture

strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="図の挿入(複数選択可）", _
MultiSelect:=True)
If Not IsArray(Filenames) Then Exit Sub

Call BubbleSort_Str(Filenames, True, vbTextCompare)

For i = LBound(Filenames) To UBound(Filenames)
Set PIC = ActiveSheet.Shapes.AddPicture( _
Filename:=Filenames(i), _
LinkToFile:=True, _
SaveWithDocument:=False, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=0, _
Height:=0)　　　←ここでエラーになります

With PIC
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMove
.PrintObject = True
End With
With PIC.ShapeRange
.LockAspectRatio = msoTrue
.Height = ActiveCell.MergeArea.Height
End With

If ActiveCell.Column = 1 Then
ActiveCell.Offset(0, 2).Select

ElseIf ActiveCell.Column = 6 Then
If ActiveCell.Row < 32 Then
ActiveCell.Offset(5, -2).Select

ElseIf i < UBound(Filenames) Then
ActiveCell.Offset(4, -5).Select
Call PictFormCopiPe
ActiveCell.Offset(1, 0).Select
End If
End If
Set PIC = Nothing
Next i

Application.ScreenUpdating = True
MsgBox i - 1 & "枚の画像を挿入しました", vbInformation
End Sub

Sub PictFormCopiPe()

Dim CrtWrkSt
Dim CurrentCell
CrtWrkSt = ActiveWorkbook.ActiveSheet.Name
CurrentCell = ActiveCell.Address()
Worksheets("PictForm").Select
Range("A1:F14").Select
Selection.Copy
Worksheets(CrtWrkSt).Select
Range(CurrentCell).Select
ActiveSheet.Paste

End Sub


Private Sub BubbleSort_Str( _
ByRef Source As Variant, _
Optional ByVal SortAsc As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbTextCompare)
If Not IsArray(Source) Then Exit Sub
Dim i As Long, j As Long
Dim vntTmp As Variant
For i = LBound(Source) To UBound(Source) - 1
For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1
If StrComp(Source(IIf(SortAsc, j, j + 1)), _
Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then
vntTmp = Source(j)
Source(j) = Source(j + 1)
Source(j + 1) = vntTmp
End If
Next j
Next i
End Sub

質問者からの補足コメント

• ごめんなさい、宣言の部分は変えてました。
  Dim strFilter As String
  Dim Filenames As Variant
  Dim PIC As Shape
  にしてあります

  No.1の回答に寄せられた補足コメントです。 補足日時：2016/10/28 11:07

• すみません、解決しました。
  Addpictureは2003でも使用できました。
  また、画像が緑色になる根本の原因は不明ですが、新規ブックから作り直したところ問題なく作動しましたので何かのバグだったようです。

    補足日時：2016/10/28 22:27

No.1 回答者： ママチャリ 回答日時： 2016/10/28 08:49

Addpictureの戻り値は、Shapeです。

よって、変数PICの型は、Pictureではなく、Shapeで宣言する必要があります。

この回答へのお礼

回答ありがとうございます。今Excel2016で作動するようになったのですが、2003で試すと画像が緑色になってしまうのですが、このAddpictureは2003では作動しないのですか？これに互換性を持たすことは可能でしょうか。

今このような状態です。他の箇所は前述したのと変えていません。

前略
For i = LBound(Filenames) To UBound(Filenames)
Set PIC = ActiveSheet.Shapes.AddPicture( _
Filename:=Filenames(i), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=640#, _
Height:=480#)

With PIC
.ScaleHeight 1!, msoTrue
.ScaleWidth 1!, msoTrue
End With

With PIC
.LockAspectRatio = msoTrue
.Height = ActiveCell.MergeArea.Height
End With
中略
Set PIC = Nothing
Next i

お礼日時：2016/10/28 11:02