Excel2010マクロ／挿入した画像がぼける

質問

過去に2度、Excel2003を利用して工事写真帳を作成する方法を質問させていただきました。最近、社内でExcel2010を使用している人が多くなり、修正した写真帳でも不具合が発生するようになり、その原因を調べているのですが同じ症例がなかなか見当たりません。そこで今回もまたお知恵を拝借したいと思い投稿しました。

【仕様】工事写真帳は複数シート構成、1シートはA4サイズで縦に3枚の画像が読み込めます。画像の右側には摘要欄があります。画像を読み込む位置をダブルクリックするとセルのサイズ（写真サイズにしてあります）を取得して画像サイズを変更して格納します。

【問題点】一度保存したファイルを開くと画像がぼける。図の書式設定の[サイズ]を確認すると、サイズと角度の高さ=9.59cm、幅=13.69cm（読み込むセルのサイズ）、原型のサイズの高さ=0.38cm、幅=0.42cmとなっています。元の画像サイズは640×480なので、マクロを実行中、どこかのタイミングで画像の一部をトリミングし、縦横サイズを小さくした画像をセルサイズにまで拡大していることが原因だということまではわかりました。ただ、すべてのシートがこの状態なわけではなく、正常に表示されているシートもあります。この場合も画像のサイズと角度の高さ=9.59cm、幅=13.69cm（読み込むセルのサイズ）、原型のサイズの高さ=9.59cm、幅=13.69cmと元の画像より小さくなっています。

コードは次の通りです。どこに問題があるか、ぜひアドバイスをお願いします。

Private Sub Workbook_SheetBeforeDoubleClick(ByVal sh As Object, ByVal Target As Range, Cancel As Boolean)

Dim pict As Shape
Dim fname

With Target
If .Column <> 3 Then Exit Sub '3列目でなかったら終了
fname = Application.GetOpenFilename _
("画像ファイル,*.gif;*.jpg;*.bmp", 1, "画像ファイルを指定して下さい") '画像読込
If fname = False Then Exit Sub
Set pict = sh.Shapes.AddPicture(Filename:=fname, linktofile:=True, _
SaveWithDocument:=True, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)

pict.LockAspectRatio = False '指定された図形のサイズ比率を保持しない
pict.Placement = xlMove 'オブジェクトをセルと共に移動する
.Offset(, 3).Select '摘要欄（右へ3）へ移動
End With

End Sub

回答No.1

DreamyCat

ご呈示のコードだけだとそのようなことは起こらないようです。
また、トリミングのコードはここには無いようなので他で記述しているのではありませんか。

linktofile:=True　で取り込んだ画像がサイズ縮小されて保存先のフォルダーにある画像サイズが変わったりするのかと何度も調べてみたのですが、調べた限りでは何の変化もみられませんでした。
なお、そのままのコードでは２０１０版で実行できず、少し修正して調べました。

お礼

時間を割いて調べてくださり感謝いたします！

VBAはネットで調べたコードをアレンジして使ったり、今回のように質問し、いただいた回答をそのまま使っているレベルなので詳しくはないのですが、質問に記載したコードは[コードの表示]-「ThisWorkbook」に記述されているものをすべてコピー＆ペーストしたものです。

問題点に心あたりがあると言えば、もともとExcel2003で作成した写真帳をExcel2010で開き、[名前を付けて保存]でExcel2010で保存したものをフォームとして運用しているからかな～？というくらいなんですが…。

linktofile:=Trueについて調べたところ、『Trueで元のファイルとのリンクを設定、Falseで独立した画像』とあったのですが、これは元画像が保存されているPC以外でファイルを開く場合にはFalseとした方が良いのでしょうか？

「Module」にかかれたコードの場合、F8（ステップイン）で一行ずつ変数の値などを確認するのですが、「ThisWorkbook」はできない？のでどこに問題があるのかわからない状況です。