マクロで画像挿入→エラー「リンクされたイメージを表

マクロを使って、フォルダ内の画像をエクセルに自動的に貼り付けできるようになりました。

http://oshiete.goo.ne.jp/qa/8357181.html
（picopico_7さんありがとうございました。）

しかし、出来上がったファイルをメールで他の人に送ると、その人のところではエラーがでて画像が見られません。「リンクされたイメージを表示できません」となります。

ネットで調べたところ、excel2010はリンクをつかって画像を表示するから？ということがわかりました。が、対処方法がわかりません。

どなたか教えて頂けませんでしょうか。
よろしくお願いいたします。


windows7
excel2010

No.4 回答者： mitarashi 回答日時： 2013/12/02 23:09

#2です。

#3さんご指摘の通り、Shapes.AddPictureと、Pictures.Insertでは幅の挙動が異なりますね。
サイズとプロパティで確認すると、Pictures.Insertの方は縦横比の固定にチェックが入っています。
また、h.Offset(0, 1).Widthへの合致という点ではShapes.AddPictureの方が合っています。
With ActiveSheet.Pictures.Insert(OpenFileName)
.Name = h
.ShapeRange.LockAspectRatio = False
（以下略）
と、明示的に縦横比固定を外してやると、双方の挙動は同じになりました。
少なくともxl2010では、.Pictures.Insertはデフォルトでは縦横比固定になる様です。逆に言うと、元のままでは
'写真サイズの設定
.Width = h.Offset(0, 1).Width
.Height = h.Offset(0, 1).Height
は、後から行った方しか有効で無いという事でしょう。
ご参考まで。

No.3 回答者： picopico_7 回答日時： 2013/12/02 11:12

こんにちは。

画像の表示までは上手くいかれたみたいで良かったです。
#1,2のmitarashiさんが書かれている通りAddpictureを使われると効率的かと思い私の方でも試してみました。
が、写真サイズの設定だけがなぜだか上手くいきませんでした(私の知識不足です)。
なので今使われているプログラムに入れた状態で記しておきます。
コピペして写真の保存場所を直してから動かしてみてください。
（ちなみに追加した部分は「'リンク貼付画像を切り取る」「'写真ファイル名が入力されているセルから２つ左のセルを選択」「'画像をExcelシート自体に貼付」のみです）

Sub macro1()
Dim p As String
Dim h As Range

'写真の保存場所
p = "C:\Users\☆☆☆\Documents\picpic\"
'現在表示されている写真は一度削除
ActiveSheet.Pictures.Delete
'商品名が入力されている行まで繰り返す
For Each h In Range("D2:D" & Range("C1048576").End(xlUp).Row)
'写真ファイルが保存されている時
If Dir(p & h) <> "" Then
With ActiveSheet.Pictures.Insert(p & h)
'写真ファイル名が入力されているセルから２つ左のセルに挿入
.Top = h.Offset(0, -2).Top
.Left = h.Offset(0, -2).Left
'写真サイズの設定
.Width = h.Offset(0, 1).Width
.Height = h.Offset(0, 1).Height
'リンク貼付画像を切り取る
.Cut
End With
'写真ファイル名が入力されているセルから２つ左のセルを選択
h.Offset(0, -2).Activate
'画像をExcelシート自体に貼付
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
End If
Next
End Sub

No.2 回答者： mitarashi 回答日時： 2013/12/01 19:19

#1です。

ご提示のコードに組み込むのは検証が面倒なので、下記コードでテストしました。ここからの載せ替えはご自分でお願いします。
Sub test()
Dim OpenFileName As String
Dim h As Range

'試験用に適当に指定
Set h = ActiveSheet.Range("D5")
OpenFileName = Application.GetOpenFilename("すべてのファイル,*.*")
If OpenFileName = "False" Then Exit Sub

'AddPictureを使用する時
'LinkToFile:=Falseだけでは不十分で、 SaveWithDocument:=Trueも必要な様です
ActiveSheet.Shapes.AddPicture(Filename:=OpenFileName, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=h.Offset(0, -2).Left, _
Top:=h.Offset(0, -2).Top, _
Width:=h.Offset(0, 1).Width, _
Height:=h.Offset(0, 1).Height).Select
Selection.Name = h.Value

'既存のPictures.Insertを生かして、クリップボード経由でJPEG形式で貼り付ける時
' With ActiveSheet.Pictures.Insert(OpenFileName)
' .Name = h
' '写真ファイル名が入力されているセルから２つ左のセルに挿入
' .Top = h.Offset(0, -2).Top
' .Left = h.Offset(0, -2).Left
' '写真サイズの設定
' .Width = h.Offset(0, 1).Width
' .Height = h.Offset(0, 1).Height
' .Cut
' End With
' h.Offset(0, -2).Activate
' ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
End Sub

No.1 回答者： mitarashi 回答日時： 2013/11/30 22:09

下記が詳しいです。

http://www.moug.net/tech/exvba/0120020.html

>Pictures.Insertメソッドを使った方法では、画像のリンク情報だけを保存する、または画像と一緒に保存するといった指定はできません。
>さらに、Excel 2007までは画像情報と一緒に保存されていたのに対し、Excel 2010でリンク貼り付けに仕様が変わるなど、Excelのバージョンによって画像の保存方法が異なります。

という訳で、Addpictureを使用して、明示的にLinkToFile:=Falseを指定して下さい。
ActiveSheet.Shapes.AddPicture( _
Filename:=myFileName, _
LinkToFile:=False, _
SaveWithDocument:=False, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=0, _
Height:=0)

参考URLにPictures.Insertメソッドを使い、クリップボードにコピーして貼り付け戻す対処方法も載っていますが、ファイルが巨大化する怖れがあります。単にペーストでなく、JPEG形式を指定して貼り付けるべきでしょう。

この回答への補足

mitarashiさん

回答ありがとうございます！
せっかくコードを貼り付けて頂いたのですが、どこにそれを入れて何を消したらいいのかわかりません。。
マクロ使い始めて１週間で何もわからなくて本当に申し訳ないのですが全体のコードをもらえませんでしょうか？
Sub macro1()
Dim p As String
Dim h As Range

'写真の保存場所
p = "C:\Users\☆☆☆\Documents\picpic\"

'現在表示されている写真は一度削除する
ActiveSheet.Pictures.Delete

'商品名が入力されている行まで繰り返す
For Each h In Range("D2:D" & Range("C1048576").End(xlUp).Row)

'写真ファイルが保存されている時
If Dir(p & h) <> "" Then
With ActiveSheet.Pictures.Insert(p & h)
.Name = h
'写真ファイル名が入力されているセルから２つ左のセルに挿入
.Top = h.Offset(0, -2).Top
.Left = h.Offset(0, -2).Left
'写真サイズの設定
.Width = h.Offset(0, 1).Width
.Height = h.Offset(0, 1).Height
End With
End If
Next
End Sub

上記が今使わせてもらっているコードです。
いろいろ削除したり貼り付けしてみたのですがうまくいきませんでした。

リンク先のクリップボードにコピーというのもどうしていいかわからず、
＞JPEG形式を指定して貼り付けるべきでしょう。
もわからないです。。
せっかく教えて頂いたのにすみません。ご回答いただけると有難いです。よろしくお願いいたします。

補足日時：2013/12/01 01:21