エクセル2010で下のようなコードでPictures.InsertとFor文を使用して複数の画像を読み込んでます。
ところが、Pictures.Insertを2010で使用すると画像がリンク貼付されてしまうため、エクセル2003で画像を見ることができません。そこで、AddPictureを使用しなければならないということは理解したのですが、ネット上のサンプルコードは1つのファイルを読み込む場合のものばかりで、今まで通りに複数の画像を読み込むためのコードがなかなかみつかりません。しかしながら、会社にはVBAを操作できる人がおらず、ネットと本で独学していますが、どうしても、どこにFor文を入れたらよいのかわかりません。厚かましいのは承知ですが、下に現在使用しているコードをコピペしましたので、どこを直せばよいのか教えていただけますでしょうか・・・。
自分でやりきれる力があればよいのですが、会社にマクロを使える人がおらず、ネットと本を見ながらやっているのですが、これ以上自分で悩んでいる時間の余裕がありません。
なんとかお助けいただけますでしょうか。よろしくお願いいたします。
--
Sub 画像挿入()
Dim strFilter As String
Dim Filenames As Variant
Dim Pic As Picture
ActiveSheet.Range("K8").Select
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)
Application.ScreenUpdating = False
For i = LBound(Filenames) To UBound(Filenames)
Set Pic = ActiveSheet.Pictures.Insert(Filenames(i))
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
ActiveCell.Offset(0, 7).Select
Set Pic = Nothing
Next i
Application.ScreenUpdating = True
End Sub
No.1
- 回答日時:
これは複数ファイルを読み込むようになっています。
実行するたびに画面の右へ移動していくので見えないだけでしょう。
なお、ファイル名順に並べ替えをしているコードを呼び出している部分はコメントアウトしてあります。
シートのズーム倍率を50%などにしておくと見えやすいかと思います。
Sub 画像挿入()
Dim strFilter As String
Dim Filenames As Variant
Dim Pic As Picture
Dim i As Long
ActiveSheet.Range("A8").Select
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)
Application.ScreenUpdating = False
For i = LBound(Filenames) To UBound(Filenames)
Set Pic = ActiveSheet.Pictures.Insert(Filenames(i))
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
ActiveCell.Offset(i, 7).Select
Set Pic = Nothing
Next i
Application.ScreenUpdating = True
End Sub
コメントありがとうございます。
上のコードを2010で実行してしまうと、画像がリンク貼り付けされるため、挿入貼付できるように書き換えたかったのです。要旨が明確でなかったので、うまくお伝えできなかったみたいです。せっかくコメント頂いたのにすみません。
困ってるときに、コメントがいただけたこと自体がとてもうれしかったです。ありがとうございました。
No.2ベストアンサー
- 回答日時:
>Pictures.Insertを2010で使用すると画像がリンク貼付されてしまうため..
というのがポイントなのですよね。
『Excel 2010 で Pictures.Insert メソッドを使用して図をワークシートに挿入すると図がリンク オブジェクトとして挿入される』
http://support.microsoft.com/kb/2396509/ja
提示されたコードはおそらく
http://oshiete.goo.ne.jp/qa/2300268.html?order=asc
こちらが元になったものなのでしょう。
Q&A掲示板でも時々見かけます。
ファイル名のSortも盛り込んであるためニーズが高く、利用している方も多いのでしょうね。
'-----------------------------------------------
Option Explicit
Sub 画像挿入()
Dim strFilter As String
Dim Filenames As Variant
Dim rng As Range '貼り付け先セル用変数
Dim i As Long
'「ファイルを開く」ダイアログでファイル名を取得
strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png)," _
& "*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="図の挿入(複数選択可)", _
MultiSelect:=True)
'IsArray関数で判定し、キャンセルの場合はExit
If Not IsArray(Filenames) Then Exit Sub
' ファイル名をソート
Call BubbleSort_Str(Filenames, True, vbTextCompare)
'マクロ実行中の画面描写を停止
Application.ScreenUpdating = False
'貼り付け開始セルを変数にセット
Set rng = ActiveSheet.Range("K8")
'順番に画像を挿入
For i = LBound(Filenames) To UBound(Filenames)
'画像挿入Sub(貼り付けセル,画像ファイル名)
Call PictureIns(rng, Filenames(i))
'次の貼り付け先を変数にセット
Set rng = rng.Offset(0, 7)
Next i
Set rng = Nothing
Application.ScreenUpdating = True
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
'-----------------------------------------------
Private Sub PictureIns(ByRef r As Range, ByVal pName As String)
'AddPictureメソッドで元ファイルにLinkせず画像挿入
With r.Worksheet.Shapes.AddPicture(Filename:=pName, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=r.Left, Top:=r.Top, _
Width:=0, Height:=0)
'縦横比固定
.LockAspectRatio = msoTrue
'Height:=0で挿入したので元サイズに戻す
.ScaleHeight 1, msoTrue
'貼り付けセルの高さに合わせる
.Height = r.MergeArea.Height
End With
End Sub
'-----------------------------------------------
画像挿入の箇所をサブプロシージャにしてます。
実行したらうまくいきました!!!
ありがとうございます。本当に助かりました。
私の乱文から要旨をご指摘いただいた上、元コードの出典元を教えていただいた上、コードまで書いて頂き、本当に嬉しい限りです。
頂いたコードはじっくり見て勉強してみたいと思います。
本当にありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Visual Basic(VBA) Excel vbaについての質問 3 2023/04/18 16:14
- Excel(エクセル) 【マクロ】スクショ印刷がうまく動かない件 5 2022/12/06 17:37
- Visual Basic(VBA) 複数のcsvファイルをExcelに一括変換したい 2 2023/03/03 12:44
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) ①ExcelVBAでカレンダーを作り、別のユザーフォームで日付を入力したいのですがエラーになります。 1 2023/02/17 18:39
- Visual Basic(VBA) サブフォルダ(データ)にある複数の.xlsxファイルのSheet3のA2セルの値で01から左側をB2 2 2022/08/14 15:46
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで枠飾り
-
大学のレポートを書くためにWor...
-
エクセルのフッター(右)に入...
-
エクセルのフッダーに四角で囲...
-
PowerDirector 11で空白時間の挿入
-
エクセルで写真の挿入 セルの中...
-
エクセルVBAで縦向きの画像の挿...
-
OO.oのDrawで挿入絵の背景を透...
-
写真9枚をA4紙に配置したい。
-
ヘッダーとフッダーの縦書き方法
-
フッターを「最前面」に
-
Wordでの文字の挿入の仕方
-
Wordに貼り付ける図の初期設定変更
-
ワードで図のサイズを固定して...
-
保存や挿入などフォルダを開く...
-
Mac office wordで画像挿入出来...
-
エクセル2007にてピアノの図柄...
-
エクセルマクロでサイズを指定...
-
メールに画像を貼り付ける方法?
-
エクセルにjpgデータ貼り付ける...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで枠飾り
-
大学のレポートを書くためにWor...
-
エクセルのフッダーに四角で囲...
-
エクセルのフッター(右)に入...
-
PowerDirector 11で空白時間の挿入
-
エクセルで写真の挿入 セルの中...
-
エクセルVBAで縦向きの画像の挿...
-
写真9枚をA4紙に配置したい。
-
ヘッダーとフッダーの縦書き方法
-
EXCELのフッターにオートシェイ...
-
フッターを「最前面」に
-
エクセルで作成した文に柄・模...
-
Win11で使える写真整理ソフトを...
-
EXCELにjpg画像を挿入...
-
OO.oのDrawで挿入絵の背景を透...
-
VBAで特定のセルに画像があれば...
-
Accessで請求書に印鑑を...
-
Wordに貼り付ける図の初期設定変更
-
保存や挿入などフォルダを開く...
-
GoodNotes5で、画像を複数選択...
おすすめ情報