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
A 回答 (1件)
- 最新から表示
- 回答順に表示
回答ありがとうございます。今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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
これ何て呼びますか Part2
あなたのお住いの地域で、これ、何て呼びますか?
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
Pictures.Insertメソッド⇒Shapes.AddPictureメソッドに変更したいです。
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
uwcs のマクロで画像認識をして...
-
画像処理したBitmapをピクチャ...
-
Excel ユーザーフォームで表示...
-
モーダルウィンドウ内で複数の...
-
UWSC 画像判定と条件分岐について
-
jqueryスライダーを2段でスライ...
-
VBAのユーザーフォームのイメー...
-
背景画像の繰り返しについて
-
UWSCでループ処理がうまくいき...
-
EXCEL VBA 複数のImageコントロ...
-
画像の2次元フーリエ変換の結...
-
「using Windows」でエラーが出る
-
UWSCの色判定
-
svgクリップパスの応用コーディ...
-
金魚すくいゲーム
-
uwscの画像認識の不具合だと思...
-
C# Picturebox 縮小・拡大時の...
-
jpgファイルの内容を比較したい...
-
画像を二値化した後、黒の部分...
-
C#で画像を他の画像に貼り付け...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
EXCEL VBA 複数のImageコントロ...
-
背景画像の繰り返しについて
-
【EXCEL VBA】ダブルクリックで...
-
UWSCの色判定
-
Excel ユーザーフォームで表示...
-
uwcs のマクロで画像認識をして...
-
UWSC「画像が無い場合」
-
uwscの画像認識に失敗します。
-
スマホでサイトの画像を長押し→...
-
VBA シート毎に画像挿入
-
VBAのユーザーフォームのイメー...
-
vb.net 画像の透過について
-
PowerPoint VBA で画像の鮮明度...
-
画像処理したBitmapをピクチャ...
-
画像認識アルゴリズムについて
-
HTMLでサイトの模写をしていま...
-
gif 画像上の ボタンに リン...
-
「using Windows」でエラーが出る
-
【WPF】画像の切り替え
-
画像のピクセルデータの取得
おすすめ情報
ごめんなさい、宣言の部分は変えてました。
Dim strFilter As String
Dim Filenames As Variant
Dim PIC As Shape
にしてあります
すみません、解決しました。
Addpictureは2003でも使用できました。
また、画像が緑色になる根本の原因は不明ですが、新規ブックから作り直したところ問題なく作動しましたので何かのバグだったようです。