Excel2010のマクロ使用時の画像が見れません

質問

Excel2010,マクロを使用して画像挿入をした時の画像が他のPC上で見れないです。どなたか助けてくださいませんか。

Excel2010,マクロを使用した画像挿入した時の画像が他のPCへ送った時に見れませんでした。
原因は画像がリンク付けさせているから他のPCだと見えなくなっているんだと思うんですが……

マクロに関しては初心者なので教えてくださる方がいらっしゃると助かります。

過去の類似した質問はだいたい見ましたがわかりませんでした。

解決したい点は
・Excelに画像挿入するときにリンク先から表示するのではなく、画像自体をExcelへ保存して
別のサーバー上で他の方が画像を見ることができるようにする

以上になります。

仕事上画像を1つのシートあたり1000枚以上必要なのでマクロが必須です。

どなたか助言をいただけることはできないでしょうか。

よろしくお願いします。

※今使用しているマクロは下記のようになります。
すいません。これも他の方のマクロを少しいじったものです。

このどこかに問題点があると思うのですが…

Sub 複数画像挿入_サイズ変更()
Dim a As Range
Dim cc As Range
Dim W As Single
Dim H As Single
Dim mx As Long
Dim fi As Long
Dim i As Long
Dim pkfile
Const myHeight = 40 '行の高さ。0-409を指定。写真のサイズがこれで調整される。
Const myWidth = 20 '列の幅。0 - 255を指定。

On Error GoTo extLine

With Application
Set a = .InputBox("画像挿入するセル選択" & vbLf & _
"複数選択可", _
"複数画像の一括挿入（セル選択）", _
Selection.Address, _
Type:=8)
pkfile = .GetOpenFilename("すべての図" & _
"(*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;" & _
"*.jpe;*.png;*.bmp;*.gif)," & _
"*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;" & _
"*.jpe;*.png;*.bmp;*.gif", 2, _
"挿入する図の選択（複数選択可）", , True)
If Not IsArray(pkfile) Then
MsgBox "ファイルが指定されていません", , _
"複数画像の一括挿入"
GoTo extLine
End If
H = .InputBox("タテ", Type:=1)
W = .InputBox("ヨコ", Type:=1)

.ScreenUpdating = False
End With

mx = UBound(pkfile)
fi = 1
For Each cc In a
If cc.Address = cc.MergeArea.Item(1).Address Then
Call picIns(cc, pkfile(fi), W, H)
fi = fi + 1
If fi > mx Then
Set cc = Nothing
Exit For
End If
End If
Next

For i = fi To mx
Set a = a(a.Rows.Count, 1).Offset(1)
Call picIns(a, pkfile(i), W, H)
Next
extLine:
Set a = Nothing
Application.ScreenUpdating = False
With Err()
If .Number <> 0 Then MsgBox .Number & ":" & .Description
End With
End Sub

Sub picIns(ByVal r As Range, _
ByVal s As String, _
ByVal W As Single, _
ByVal H As Single)

With ActiveSheet.Pictures.Insert(s).ShapeRange
If (W > 0) And (H > 0) Then
.LockAspectRatio = msoFalse
.Height = H
.Width = W
ElseIf W > 0 Then
.Width = W
ElseIf H > 0 Then
.Height = H
End If
.Left = r.Left
.Top = r.Top
End With
End Sub

回答No.5

DreamyCat

適当に書き換えても動かないのは仕方がないことです。
エラーが出るところで、なぜエラーになるのか考えて修正します。

前回提示したコード・・・　selectを使って１０００枚も処理するとしたら何だかたいへんなことになりそうな気がするので。
ActiveSheet.Shapes.AddPicture("C:\Program Files\Microsoft Office\MEDIA\OFFICE14\AutoShap\BD18234_.wmf", msoTrue, msoFalse, 100, 100, 120, 80).Apply

selectは使わないほうがいいのですが、わかりやすくするなら
Applyをselectにして
　with selection
.height= のようにする

あるいは、Selectを使わないで　with のところをこのようにする。
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.Height = 200

お礼

再度回答ありがとうございます。
マクロについては初心者なので調べながら試行しています。
相変わらず何かがおかしいようです。

もしかすると私が勉強不足のためDreamy Catさんがおっしゃていることを理解できていないのかもしれません。
大変申し訳ありません。
今回変更したのは

【過去】
With ActiveSheet.Pictures.Insert(s).ShapeRange
If (W > 0) And (H > 0) Then
.LockAspectRatio = msoFalse
.Height = H

【現在】
With ActiveSheet.Shapes.AddPicture("C:\Program Files\Microsoft Office\MEDIA\OFFICE14\AutoShap\BD18234_.wmf", msoTrue, msoFalse, 100, 100, 120, 80).Apply
If (W > 0) And (H > 0) Then
.LockAspectRatio = msoFalse
.Height = H
.
です。

変更するのは
ActiveSheet.Pictures.Insert(s).ShapeRange
↓
ActiveSheet.Shapes.AddPicture("C:\Program Files\Microsoft Office\MEDIA\OFFICE14\AutoShap\BD18234_.wmf", msoTrue, msoFalse, 100, 100, 120, 80).Apply
だけで動くのでしょうか。いや何か私が理解していない点で間違っている気がします…(泣き

それと質問なのですが
フルパス名を入れる点はそのフルパス名の画像を挿入するという考えでよろしいのでしょうか？
そうすると複数選択して画像を入れるときには何か変数を用意してやるのでしょうか？

Dreamy Catさんは変更したソースで動きましたか？

まだ未熟で意味不明なことを言ってしまっているかもしれません。
どうか知恵をお貸しください。

回答No.4

nicotinism

こちらのやり取りが参考になるのでは？
http://www.moug.net/faq/viewtopic.php?t=63479
二つの方法を紹介されています。
1000枚の画像だと途中でExcelがどうにかなってしまいそうです。
バックアップはお忘れなく。

回答No.3

DreamyCat

With ActiveSheet.Pictures.Insert(s).ShapeRange
のところを下のコードを参考に書き換えてみてください。
100, 100, 120, 80はそれぞれ
left top width heightです。

ActiveSheet.Shapes.AddPicture("C:\Program Files\Microsoft Office\MEDIA\OFFICE14\AutoShap\BD18234_.wmf", msoTrue, msoFalse, 100, 100, 120, 80).Apply

１枚が100KBとしても１０００枚だと運用できるのか心配ですね。

お礼

ご回答ありがとうございます。

結果から言わせていただきますとダメでした…
何がいけないのでしょうか。

2010ではPicture.InsertではなくShapes.Addを使わなければいけないことは他の質問からも理解できました。

今回私はDreamyCatの意見を参考にしつつ、以下のように変更して試しました。

今まで：With ActiveSheet.Pictures.Insert(s).ShapeRange

今回：　With ActiveSheet.Shapes.AddPicture("フルパス名.bmp", msoTrue, msoFalse, 100, 100, 120, 80).Apply

※最後の.Applyの部分は.Apply、Select、.ShapeRangeの3通りで試しました。

エラー内容は
「'438':オブジェクトは、このプロパティまたはメソッドをサポートしていません」
です。

以前の場合はエラーは起きません。

画像の数が多くて運用できない可能性もありますが、
とりあえず作成してからではないと上司が納得しないので…

なにが悪いのでしょうか。

回答No.2

akina_line

こんにちは。

　私もExcel上に何100枚もの画像を貼り付ける(リンクではなく、直接挿入する)マクロを作成しています。

　画像を貼り付けるところは下記のマクロを使用しています。
　　 ActiveSheet.Pictures.Insert(Gname).Select

　貴方のマクロも同様な記述がありますが、
　　　ActiveSheet.Pictures.Insert(s).ShapeRange
　これを上のマクロを参考に下記のように修正したらどうでしょう。
　　　ActiveSheet.Pictures.Insert(s).Select

では。

お礼

ご回答ありがとうございます。

試してみた結果
「438:オブジェクトは、このプロパティまたはメソッドをサポートしていません」
となりました。

他にも試したところ同じようなエラーが出るときが多々あります。
何が悪いのでしょうか…

回答No.1

codotjtp

セキュリティ対策ソフトウェアが邪魔を致していませんでしょうか？

複数のPCでの検証は可能でしょうか？

どういう方式で、其のファイルが配布されていますでしょうか？

補足

セキュリティ系を切ったりしてもダメでした。

複数のPCでも検証しています。

>どういう方式で、其のファイルが配布されていますでしょうか？

これに関しましては自分のPCにある画像をexcelで作成し、会社のサーバーに挙げています。
そこでは見れないようです。
また、メールで他のPCに送っても見れていません。