エクセルに写真を挿入するマクロを組んでいます。

質問

エクセルに写真を挿入するマクロを組んでいます。
２００３までは問題なく動作していたマクロが、
２００７では位置調整がうまく行きません。
　そこでネットで検索して
With Selection
.Left = Range("C6").Left
.Top = Range("C" & rowa).Top
End With
のように　Selection.Left　を使えば解決するとありましたが、

(1)ＷＩＮ　ＶＩＳＴＡのエクセル２００７では
おなじひとつのエクセルファイルの
あるシートではコード通りが位置でるのに
違うシートでは縦位置がずれる。

(2)ＷＩＮ　ＸＰのエクセル２００７では
すべてのシートで縦位置がずれる。
ただし、ずれの位置は(1)よりは少ない。

といずれのＯＳでも不具合が出ます。

　事情によりエクセル２００７でこのマクロを使用しなければならなくなり
非常に困っております。
どなたか解決方法をご存知の方、よろしくお願いします。

　なお、(2)のＷＩＮ　ＸＰでは、エクセル２００３も入っており、
その中では、全く問題なくマクロが動作しています。
実際のコードは下の通りです。

Sub 写真呼出(koumoku, jpgf, tr As Variant)
Dim rowa As String

ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = tr　←選択したセルの行ナンバー

ActiveSheet.Pictures.Insert(motopath & "写真\" & koumoku & "\" & jpgf & ".JPG").Select
Selection.Name = "写真"

Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比の固定
Selection.ShapeRange.Height = 480

'Selection.ShapeRange.IncrementLeft 100　←不具合が出たので止めた部分
'Selection.ShapeRange.IncrementTop 40　　←不具合が出たので止めた部分

rowa = tr + 2

With Selection
.Left = Range("C6").Left
.Top = Range("C" & rowa).Top
End With

End Sub

回答No.4

end-u · ベストアンサー

2007はPictures.Insertメソッドで位置がズレるという話があったような気がしますね。
私のwinXPsp3/xl2007sp2(12.0.6535.5002)環境で試してみましたが、
どうも再現しません。
OfficeUpdateはお済みでしょうか。
#必要なら後日Vistaでも試してみますが。

とりあえず
【お試し案１】Selectしない
Dim rowa　As String
Dim fname As String
rowa = tr + 2
fname = motopath & "写真\" & koumoku & "\" & jpgf & ".JPG"
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = tr
With ActiveSheet.Pictures.Insert(fname)
　　.ShapeRange.LockAspectRatio = msoTrue
　　.Name = "写真"
　　.Height = 480
　　.Left = Range("C" & rowa).Left
　　.Top = Range("C" & rowa).Top
End With

【お試し案２】Zoom変更
Dim rowa　As String
Dim fname As String
Dim n　　 As Long
rowa = tr + 2
fname = motopath & "写真\" & koumoku & "\" & jpgf & ".JPG"
With ActiveWindow
　　n = .Zoom
　　.Zoom = 100
End With
ActiveSheet.Pictures.Insert(fname).Select
With Selection
　　.ShapeRange.LockAspectRatio = msoTrue
　　.Name = "写真"
　　.Height = 480
　　.Left = Range("C" & rowa).Left
　　.Top = Range("C" & rowa).Top
End With
With ActiveWindow
　　.Zoom = n
　　.ScrollColumn = 1
　　.ScrollRow = tr
End With

【お試し案３】Shapes.AddPictureメソッド
Dim rowa　As String
Dim fname As String
rowa = tr + 2
fname = motopath & "写真\" & koumoku & "\" & jpgf & ".JPG"
With ActiveSheet.Shapes.AddPicture(Filename:=fname, _
　　　　　　　　　　　　　　　　　 LinkToFile:=msoFalse, _
　　　　　　　　　　　　　　　　　 SaveWithDocument:=msoTrue, _
　　　　　　　　　　　　　　　　　 Left:=Range("C" & rowa).Left, _
　　　　　　　　　　　　　　　　　 Top:=Range("C" & rowa).Top, _
　　　　　　　　　　　　　　　　　 Width:=100, _
　　　　　　　　　　　　　　　　　 Height:=100)
　　.ScaleHeight 1, msoTrue
　　.ScaleWidth 1, msoTrue
　　.LockAspectRatio = msoTrue
　　.Name = "写真"
　　.Height = 480
End With
With ActiveWindow
　　.ScrollColumn = 1
　　.ScrollRow = tr
End With

お礼

end-uさん、詳しい御説明ありがとうございました。
あらためてお礼申し上げます。

　なお、上記の補足の追加です。
お試し案を試したのは自宅パソコンで
WIN XP SP3で、エクセル2007SP?（12.0.4518.1014）です。

　また、同じパソコンに混在しているエクセル2003で試したところ
お試し案１，３とも表示位置は正しく出ていましたが
写真の横サイズが調整されずに元のサイズのまま？長くなっていました。
（極端に横長の写真表示になっている）
お試し案２では、正常なサイズで表示されていました。

　この辺りもなぜそうなるのか不明です。

補足

end-uさん、非常に詳しいご回答ありがとうございます。

　さっそく試してみたところ

お試し案１⇒横位置、縦位置ともにずれる。
　　　　　　(2)の結果と同じ不具合が出る。

お試し案２⇒すべてのSheetで正しい位置で表示される。
　　　　　　ただし、画面表示が一度大きくなってから元に戻る。

お試し案３⇒縦位置だけ少しずつずれていく。
　　　　　　ただし、お試し案１よりは、ずれ幅は小さい。

　という結果になりました。
この結果から推察されることがありましたら
また、ご教示くださると幸いです。

　今の状況ですと、お試し案２で行くことになりますが、
画面がちらつくのが少々煩わしいです。
　確かこのちらつきは出させない命令があったようですが、
よく覚えていません。（汗）

回答No.6

end-u

ぁ、失礼。
>fname = motopath & "@myDoc\" & koumoku & "\" & jpgf & ".JPG"
こりゃ自分の環境でしたorz
fname = motopath & "写真\" & koumoku & "\" & jpgf & ".JPG"
修正してくださいね。

お礼

end-u さん、たびたびありがとうございます。

　ご指摘の通り、Microsoft Updateで最新のものに
更新したところ、上記の不具合が解消されました。
　質問した最初のコードで行けましたので、とりあえず
これで行きたいと思います。
　本当にどうもありがとうございました。

〈補足〉
　今回はMicrosoft Updateで直りましたが、
実はもう一つ不具合があります。
（jpegファイルを呼び出すのに2003までなら行けるのに
この2007では呼び出しに失敗するところがあります。←同じコードなのに）
　この不具合については、また改めて質問させていただきたいと思います。

回答No.5

end-u

Zoomの問題のようですね。
>WIN XP SP3で、エクセル2007SP?（12.0.4518.1014）です。
OfficeUpdateで直りそうな気もしますが、以下で。

Sub 写真呼出(koumoku, jpgf, tr As Variant)
　　Dim rowa　As String
　　Dim fname As String
　　Dim n　　 As Long
　　Dim r　　 As Range

　　On Error GoTo errHndlr
　　rowa = tr + 2
　　fname = motopath & "@myDoc\" & koumoku & "\" & jpgf & ".JPG"
　　Set r = ActiveCell
　　With Application
　　　　.ScreenUpdating = False
　　　　.EnableEvents = False
　　　　.Goto Range("A" & tr), True
　　End With
　　With ActiveWindow
　　　　n = .Zoom
　　　　.Zoom = 100
　　End With
　　With ActiveSheet.Pictures.Insert(fname)
　　　　.ShapeRange.LockAspectRatio = msoTrue
　　　　.ShapeRange.Height = 480
　　　　.Left = Range("C" & rowa).Left
　　　　.Top = Range("C" & rowa).Top
　　　　.Name = "写真"
　　End With
　　ActiveWindow.Zoom = n
　　r.Activate

errHndlr:
　　Set r = Nothing
　　With Application
　　　　.EnableEvents = True
　　　　.ScreenUpdating = True
　　End With
End Sub

>お試し案１，３とも表示位置は正しく出ていましたが
>写真の横サイズが調整されずに元のサイズのまま？長くなっていました。
１，２は、ShapeRangeに対してHeight変更するのを忘れてました。すみません。
３は...再現しなかったのでわかりません。ActiveCell位置も関係ないですしね。
２ならありえますが。
上記コードはその辺りも一応考慮してます。

いずれにしても、Service Packはあてといた方が良いと思いますけども。
http://support.microsoft.com/kb/928116/ja
Microsoft Updateを利用してください。
http://update.microsoft.com/microsoftupdate/v6/default.aspx?

>#必要なら後日Vistaでも試してみますが。
ちなみにVistaでも再現しませんでした。

回答No.3

imogasi

２００７で検証が出来ないのですが、私は
Top = Range("C" & rowa).Top
のセルについて
質問者が目指すものと
コード実行の現実が違うだけで、
この程度の内容の個所は、バージョンの変更で影響を受けてないと予想します。
テストをじっくりしてみるのが先決ではないですか。
具体的にC6などセルを指定しても「ずれ」が起こりますか？その際セルのシートを明示のこと。
他にシートのセルと貼り付けた図形（オブジェクト）の位置関係をコントロールする、「図の書式設定」の「プロパティ」なども、念のためチェックを。

補足

imogasiさん、ご回答どうも有難うございます。

＞この程度の内容の個所は、バージョンの変更で影響を受けてないと予想します。
私もそう思う部分もあります。

　と言いますのも、このマクロを実行させた場合、
同じエクセル2007でも結果が微妙に違っているからです。

　最初の質問のところで書きましたが
(1)WIN VISTA　では　ある特定のシート（1枚だけですが）では正常に表示され
　その他のSheetではすべての表示が少しずつずれる。
　（詳しく書きますと）
　項目別に複数のSheetがあり、各SheetのA列にはjpegファイル名が表示されています。
　jpegファイル名の入ったセルをクリックすると、例えばそのセルが(4,1)とすると
　セル(6,3)の左上からそのクリックした写真を表示させています。
　（列位置は3列目に固定、行位置は選択セルの2行下）
　(1)の環境では、下の方のセルをクリックすればするほど縦位置のずれが大きくなる
　ということです。

(2)WIN XPでは、表示位置はすべてのSheetでずれます。
　ただしずれ幅は(1)の場合より少ないです。

　つまり、おなじマクロでも、実行させる環境で異なる結果が出ますので、
OSやエクセルの設定が異なることからの不具合とも考えられます。

　ただ
＞他にシートのセルと貼り付けた図形（オブジェクト）の位置関係をコントロールする、
＞「図の書式設定」の「プロパティ」なども、念のためチェックを。
など、よく分からないところもありますので、
具体的なチェックポイントを教えていただければ幸いです。

回答No.2

hige_082

＃１です
難しいです
関連するコードが分らないので無理に近いですよ
関連するすべてのコードを見ないと
どのコードが関係しているのかわかりません

＞因みに
＞'Cells(tr, 3).Select
＞でこのコードを無効化すると何故か・・・
原因が特定できません
良い方法では有りませんが
Application.EnableEvents = False
Cells(tr, 3).Select
Application.EnableEvents = True
としたらどうなります？

アドバイスとしては
コード中のselection(select)を極力無くしてください
selectionでは何に対して処理をしているのかが分りにくい
スキルが上がってくると最後の表示くらいにしか使用しません

Worksheet_SelectionChangeなどイベントを使用する場合は
範囲を限定して他のコードに影響のないようにする
今回のように"Cells(tr, 3).Select"を実行すると
無限ループにならないよう対策をする必要があると思います

すべてのコードを見直す必要があると思いますよ

補足

hige 082さん、再度のご回答ありがとうございます。

Application.EnableEvents = False
Cells(tr, 3).Select
Application.EnableEvents = True
を試してみましたが、写真の表示⇒表示⇒表示⇒・・・
の繰り返しで修正前と同じ結果となりました。

上記のSubルーチンは、写真の表示だけに使うためのもので
今回の不具合についてはこの部分だけと考えています。
確かに、Worksheet_SelectionChangeを使うなど注意が
必要なところもありますが、
エクセル2003では正常な位置に（全てのSheetで）表示されますので、
エクセル2007特有の問題と思っているのですが。

回答No.1

hige_082

たいした修正はしていませんが、試してみて

Sub 写真呼出(koumoku, jpgf, tr As Variant)
Dim rowa As String
Cells(tr, 3).Select
rowa = tr + 2
ActiveSheet.Pictures.Insert(motopath & "写真\" & koumoku & "\" & jpgf & ".JPG").Select
Selection.Name = "写真"
With ActiveSheet.Pictures("写真")
.LockAspectRatio = msoTrue '縦横比の固定
.Height = 480
.Left = Range("C" & rowa).Left
.Top = Range("C" & rowa).Top
End With
End Sub

excel2007を持っていないので検証できてません

参考程度に

補足

回答どうもありがとうございます。
さっそく試してみましたが、このマクロでは

Worksheet_SelectionChange
を使っており、
Cells(tr, 3).Select
の部分で誤動作（写真の表示、消去、また表示の
無限ループ）を起こします。

因みに
'Cells(tr, 3).Select
でこのコードを無効化すると何故か
With ActiveSheet.Pictures("写真")
.LockAspectRatio = msoTrue '縦横比の固定
.Height = 480
.Left = Range("C" & rowa).Left
.Top = Range("C" & rowa).Top
End With
が全く効かないです。

なお、今は(2)のＷＩＮ　ＸＰでの環境しか試せません。
また補足ですが、
.Left = Range("C6").Left　はご指摘の通り
.Left = Range("C" & rowa).Left　が正しいです。