ここから本文です

エクセルマクロの質問です。

yam********さん

2010/7/2816:05:52

エクセルマクロの質問です。

エクセルマクロの質問です。
初心者でして、、、是非お願いします。

「2か所のセル(B7とH7)に、A1とA2に入力されている文字のファイル名の写真(jpg)を、図の挿入で貼り付けて、
サイズを変えて既定の大きさにする」というマクロを作りました。
*写真の入れてあるフォルダは「mypcの共有の写真」に入っています。


↓↓以下、書いたマクロ

Sub 写真()

Dim DIR As String
Dim A As String
Dim B As String

DIR = "\\mypc\共有\写真\"

A = DIR & Rance("A2").Value & ".jpg"
B = DIR & Range("A2").Value & ".jpg"

Range("B7").Select
ActiveSheet.Pictures.Insert(A).Select

Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 184.8373
Selection.ShapeRange.Width = 253#
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop 0.75


Range("H7").Select
ActiveSheet.Pictures.Insert(B).Select

Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 184.8373
Selection.ShapeRange.Width = 253#
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop 0.75


Range("A1").Select


End Sub

↑↑以上

マクロを実行すると予定通り写真は貼られました。

しかし、\\mypc\共有\写真\から写真を消すと、次からは表示されません。
どうやらリンクで貼られているようです。
理想は、手作業でいうところの、挿入→図で貼り付けたようになっているつもりで、このマクロを組みました。
(ほかの人にこのファイルを渡したい。もちろん写真の元ファイルは渡さずに。)

どこが違うのでしょうか・・・?

よろしくご指導お願いします。

補足調べていくとエクセル2007からは
ActiveSheet.Pictures.Insert
が対応していないようです。

当方エクセル2010を使っています。


代わりに
Set myShape = ActiveSheet.Shapes.AddPicture
というのを使うというところまでは来ましたが、惜しい所で動きません。

是非よろしくお願いします。

閲覧数:
455
回答数:
2
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

ann********さん

2010/7/2817:25:00

> どうやらリンクで貼られているようです。

リンクでしたら、\\mypc\共有\写真\ に写真を戻すと表示される
ことになりますが、試されました?
何らかの障害で表示されないだけではないのでしょうか。

参考:ハードウェアアクセラレータのレベル変更で解消
*ttp://my.opera.com/karakara/blog/show.dml/845317

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜1件/1件中

vcx********さん

2010/7/2900:08:54

何度も試しているうちに、同じ位置に同じ画像がどんどん挿入されてメモリー不足になって表示されないとか、、、

これで上手く動くかはわかりませんがサンプルです。
元のコードに使われている変数 「DIR」 はシステムで使われている Dir関数 とダブるので使用しない方が無難かと思います。

Sub Test()
Dim myPath As String, fName As String, sh As Shape
Dim r As Range, i As Integer, myRng

myRng = Array("B7", "H7")
myPath = "\\mypc\共有\写真\"

With ActiveSheet
For i = 1 To 2

'画像表示セル
Set r = .Range(myRng(i - 1))
'同じ位置に前の画像があったら消す
For Each sh In .Shapes
If sh.TopLeftCell.Address = r.Address Then sh.Delete
Next sh

'取込む画像のパス
fName = myPath & .Range("A" & i).Text & ".jpg"

'実際にあれば取込む
If DIR(fName, vbNormal) <> "" Then
.Shapes.AddPicture fName, False, True, _
r.Left, r.Top, r.Width, r.Height
Else
MsgBox .Range("A" & i).Text & ".jpg は見つかりません。", vbExclamation, "NoImage"
End If
Next i
End With
End Sub

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる