EXCEL2007 VBAで選択領域に写真を表示できません。

質問

EXCEL2007 VBAで選択領域に写真を表示できません。

どなたか教えてください。使用OSはVistaでEXCEL2007を使用しています。

2003では正常に表示されていた、そのままの内容のマクロを使用しているのですが、
なぜか、写真が指定した位置に貼り付きません。
2003と2007では何かが違っていて、別の内容のマクロにしなければならないのでしょうか?
実際のマクロを以下に記します。このマクロの内容は、

マクロの実行中に貼り付ける写真ファイルを指定して、マクロ実行前に選択していた領域の中
に写真を貼付け、縦幅と横幅から計算した縮尺で、サイズを調整して領域の中央にちょうど収
まるようにしています。
2007では、表示される位置は違いますが、サイズ調整だけはうまくいっているようです。

厚かましいお願いで申し訳ありませんが、どうぞよろしくお願いいたします。

Sub TEST()
'
Dim SR As Range, PN As String, SN As String
Set SR = Selection
PN = Application.GetOpenFilename("写真ファイル(*.jpg),*.JPG", 2, _
"写真ファイルの指定", , False)
Call PIC(SR, PN, SN)
'Range("SHAPENAME").Cells(1, 1) = SN ' 後で消すためのシェイプ名をシート内に記入
'
End Sub
Sub PIC(SR, PN, SN)
'
SR.Select ' 写真貼付領域を選択
SH = Selection.Height ' 貼付領域の高さ
SW = Selection.Width ' 貼付領域の幅
ActiveSheet.Pictures.Insert(PN).Select ' 写真ファイル貼付
SN = Selection.ShapeRange.Name ' シェイプの名前を記録
RH = Selection.ShapeRange.Height ' 写真情報の高さ
RW = Selection.ShapeRange.Width ' 写真情報の幅
S1 = SH / RH ' 高さから決まる縮率
S2 = SW / RW ' 幅から決まる縮率
SC = WorksheetFunction.Min(S1, S2) ' 縮率の最小値
With Selection.ShapeRange ' 写真情報の
.Height = RH * SC * 0.995 ' 高さを調整
.Width = RW * SC * 0.995 ' 幅を調整
.IncrementTop (SH - RH * SC) / 2 + RH * SC * 0.005 ' 上端の位置を調整
.IncrementLeft (SW - RW * SC) / 2 + RW * SC * 0.005 ' 左端の位置を調整
End With
'
End Sub

回答No.3

jcctaira

P8380107さん こんにちは。

> できれば2003と2007両方にそのまま使えるマクロ…
EXCEL2003,2007でテストを行いましたが、どちらも同じ結果でしたよ。
ただ、P8380107さんが考えている上位置、左位置は勘違いしていました。
以下のように(.Top,.Left）を訂正すれば問題はないかと思います。

　With Selection.ShapeRange　　　　　　　　　　　　　　　　　　　　　　'写真情報の
　　　.Height = RH * SC * 0.995　　　　　　　　　　　　　　　　　　　　' 高さを調整
　　　.Width = RW * SC * 0.995　　　　　　　　　　　　　　　　　　　　　' 幅を調整
　　　.Top = ST + (SH - RH * SC) / 2 + RH * SC * 0.005　　　　　' 上端の位置を設定 ★
　　　.Left = SL + (SW - RW * SC) / 2 + RW * SC * 0.005　　　　' 左端の位置を設定 ★
　End With

EXCEL2003,2007の両方で確認してください。

お礼

いろいろ時間を取らせたみたいで本当に申し訳ありません。

実は、Ｎｏ３の回答は今確認したところなんですが、

その前に、帰宅して２００７でいろいろとやってまして、
私も「.Top =」の形にすればとりあえずうまくいくことを
発見したところでした。

ただ、まだ少し問題が残ってまして、
前に他でも類似の質問があったように記憶していますが、
実は今対象としているブックの当該シート内には、最大８枚の写真(当該マクロで貼付)と
６個のフォームコントロールのマクロボタン(そのうちの１個がこのマクロ)と
３２個のオートシェイプで作ったマクロボタンが配置されています。
問題なのは、このマクロを実行すると、
マクロで同時に連続して貼り付けた７枚の写真(最後の１枚だけ正常)と
もともと表示されていてマクロ内で触れていない３２個のオートシェイプのマクロボタンが
少しだけずれて表示されてしまいます。
なんだかOSかEXCELか画面のコントロールのバグのようにも感じられ、オートシェイプ内の
文字だけはズレずに、枠と領域着色だけがずれます。
なお、これは何かの拍子(例えばブックを上書き保存しても)で正しい位置に勝手に
戻っているようです。

今後は、
もう少しだけ何とかならないか研究してみようと思っておりますが、
最終的に解決しなかったら、マクロ内にブック保存かなにかを入れようとも考えています。

それでは、とりあえず、
本当にありがとうございました。おかげさまで、解決の兆しが見えてきて本当に助かりました。

回答No.2

jcctaira

画像が貼りついた位置が多分2003と違うのだと思います。
その位置を基準にせずに、セルの位置を基準にした方が良いと思います。
★印が付いたステートメントが修正した箇所です。
　ただ位置の式は間違っているかも知れませんので修正してください。

Sub PIC(SR, PN, SN)
　SR.Select ' 写真貼付領域を選択
　SH = Selection.Height　　 ' 貼付領域の高さ
　SW = Selection.Width　　　' 貼付領域の幅
　ST = Selection.Top　　　　' 貼付領域の上位置　★
　SL = Selection.Left　　　 ' 貼付領域の下位置　★
　ActiveSheet.Pictures.Insert(PN).Select ' 写真ファイル貼付
　SN = Selection.ShapeRange.Name 　　　　　' シェイプの名前を記録
　RH = Selection.ShapeRange.Height　　　　 ' 写真情報の高さ
　RW = Selection.ShapeRange.Width　　　　　 ' 写真情報の幅
　S1 = SH / RH ' 高さから決まる縮率
　S2 = SW / RW ' 幅から決まる縮率
　SC = WorksheetFunction.Min(S1, S2)　　　 ' 縮率の最小値
　With Selection.ShapeRange　　　　　　　　 ' 写真情報の
　　　.Height = RH * SC * 0.995　　　　　　　 ' 高さを調整
　　　.Width = RW * SC * 0.995　　　　　　 　 ' 幅を調整
　　　.Top = ST + RH * SC * 0.0025 　　　　' 上端の位置を設定 ★
　　　.Left = SL + RW * SC * 0.0025 　　　 ' 左端の位置を設定 ★
　End With
End Sub

お礼

早速のご回答ありがとうございました。

ただ、
ご教授いただいた内容及びさらにいろいろと改造を試みてみましたが、
結局うまくいきませんでした。(今のところ、２００３のみでチェック)

少なくとも２００３では、
上端や左端位置の指定は、あくまでも選択領域の上左端が基準のようです。
なお、２００７でのチェックは、夜にしか出来ませんので、
(職場に２００７が載っているＰＣが無いため)確認次第改めて
ご報告させていただきます。

また、最終的にどうしても２００３と２００７で文法等が違うのも
別の方法で解決可能だと思いますので、やむなしと考えています。

まずは、お礼まで。

補足

質問の方に入力していませんでしたが、
できれば2003と2007両方にそのまま使えるマクロとしたいと思っております。

回答No.1

aloha88600

直接的な回答ではありませんが、

ワタシの環境ではまだ2003までです
2007では画像貼り付け系がことごとくNGであったのを確認しています
これは仕方が無いようです
って　ホント困りモノです

業務系の現在運用しているものを今後どうしようか
アタマを悩ませています
複数の環境下で使われる為　現在は2003までとしていますが
いずれは切り替えなくてはいけません
しかしいっぺんには無理です
・・・。　はぁ