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で質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Visual Basic(VBA) 複数のcsvファイルをExcelに一括変換したい 2 2023/03/03 12:44
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) サブフォルダ(データ)にある複数の.xlsxファイルのSheet3のA2セルの値で01から左側をB2 2 2022/08/14 15:46
- Excel(エクセル) Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて 2 2022/11/15 16:14
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたい 6 2023/01/23 12:00
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
HTMLでこの画像を表示したいで...
-
Visual Basic : ImageListの画...
-
「using Windows」でエラーが出る
-
UWSCの色判定
-
画像をロックしたい
-
画像のビット数を変更する方法
-
決められた4つの座標をランダム...
-
UWSC 画像認識で条件分岐
-
背景画像の繰り返しについて
-
UWSCの画像認識と条件分岐につ...
-
UWSC「画像が無い場合」
-
gif 画像上の ボタンに リン...
-
【EXCEL VBA】ダブルクリックで...
-
UWSCを使った画像認証マク...
-
vb.net 画像の透過について
-
検索キーワードがわかる広告無...
-
VBA シート毎に画像挿入
-
イメージマップでマウスオーバ...
-
uwscの画像認識に失敗します。
-
C# 画像のトリミング処理
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【EXCEL VBA】ダブルクリックで...
-
背景画像の繰り返しについて
-
EXCEL VBA 複数のImageコントロ...
-
「using Windows」でエラーが出る
-
jqueryスライダーを2段でスライ...
-
画像のピクセルデータの取得
-
ImageMagickでgif画像の一部が...
-
Excel ユーザーフォームで表示...
-
uwcs のマクロで画像認識をして...
-
uwscの画像認識に失敗します。
-
vb.net 画像の透過について
-
VBA シート毎に画像挿入
-
UWSC 画像判定と条件分岐について
-
UWSC「画像が無い場合」
-
gif 画像上の ボタンに リン...
-
Pythonでgif画像が上手く作れない
-
VBAのユーザーフォームのイメー...
-
UWSC 画像認識で条件分岐
-
パネルに画像
-
【WPF】画像の切り替え
おすすめ情報
ごめんなさい、宣言の部分は変えてました。
Dim strFilter As String
Dim Filenames As Variant
Dim PIC As Shape
にしてあります
すみません、解決しました。
Addpictureは2003でも使用できました。
また、画像が緑色になる根本の原因は不明ですが、新規ブックから作り直したところ問題なく作動しましたので何かのバグだったようです。