エクセルのマクロについて

質問

OS：XP　Excel:2007

お世話になります。
マクロ初心者ですが宜しくお願いします。

エクセルにワードの文字を挿入するマクロを組んでみたのですがセルのサイズの取得方法が解りません。
挿入したオブジェクトのサイズを数値にて指定するところまでは出来たのですが、選択されているセルのサイズに合わせる為にはどうしたら良いでしょうか？
宜しくお願いします。

Sub 起動コピー()
Call word起動
Call wordコピー
Call 形式を選択して貼付
Call セルに合わせる
End Sub

Sub word起動()
Set wd = CreateObject("word.Application")
wd.Visible = True
wd.Documents.Open Filename:= _
"C:\Documents and Settings\aaa.docx"

End Sub
Sub wordコピー()
Dim wdApp As Word.Application
Set wdApp = GetObject(, "word.application")
wdApp.Run "copy"
wdApp.quit
End Sub

Sub 形式を選択して貼付()
ActiveSheet.PasteSpecial Format:="Microsoft Office Word 文
書 オブジェクト", Link:= _
False, DisplayAsIcon:=False
End Sub

Sub セルに合わせる()
Selection.ShapeRange.ScaleHeight 1.08, msoFalse, msoScaleFr
omTopLeft
Selection.ShapeRange.ScaleWidth 0.93, msoFalse, msoScaleFro
mTopLeft
End Sub

回答No.3

ASIMOV · ベストアンサー

＞Selection.ShapeRange.ScaleHeight h, msoFalse, msoScaleFromTopLeft

この場合の h はShapeの高さではなく
もとの高さと貼り付ける高さの比率を入れる様です

ですので
１．貼り付けたShapeの高さを取得する
２．貼り付けるセルの高さを取得する
３．高さの比率を計算して、H に入れ
Selection.ShapeRange.ScaleHeight H, msoFalse, msoScaleFromTopLeft
等を実行する、という手順になると思います
（幅についても同様）

お礼

ありがとうございました。
ちょと時間もなかった為、強引ですが下記のようにしてなんとか思い通りの操作になりました。

Sub ()
w = Selection.Width / 6.45
h = Selection.Height / 1.03
ActiveSheet.PasteSpecial Format:="Microsoft Office Word 文書 オブジェクト", Link:=False, DisplayAsIcon:=False

Selection.ShapeRange.ScaleHeight 　h /18,msoFalse,msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth w / 9.95, msoFalse,msoScaleFromTopLeft

回答No.2

ASIMOV

たぶん．．

＞H = Selection.Height
＞w = Selection.Width
は
H = Selection.ColumnHeight
w = Selection.ColumnWidth
原因判りませんが、Columnを付けないとWが6.4倍くらいの値になります
Hの方は付けても付けなくても同じ値になるのに？
さらに
＞Selection.ShapeRange.ScaleHeight w, msoFalse, msoScaleFromTopLeft
は、
Selection.ShapeRange.ScaleHeight H, msoFalse, msoScaleFromTopLeft
じゃないですか？
＞Selection.ShapeRange.ScaleWidth H, msoFalse, msoScaleFromTopLeft
も、同様に
Selection.ShapeRange.ScaleWidth w, msoFalse, msoScaleFromTopLeft
じゃないでしょうか？

お礼

たびたびありがとうございます。
色々試行錯誤してみて下記のコードにしてみましたがエラーは出ないもののサイズが
（オブジェクトの高さ×セルの高さ＝変更後のオブジェクトの高さ）
のように設定されているようです。

Sub 形式選択貼付()
w = Selection.ColumnWidth
h = Selection.RowHeight
ActiveSheet.PasteSpecial Format:="Microsoft Office Word 文書 オブジェクト", Link:=False, DisplayAsIcon:=False
Selection.ShapeRange.ScaleHeight h, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth w, msoFalse, msoScaleFromTopLeft
End Sub

ＷとＨは試しに入れ替えてみた時のなごりで元に戻し忘れてました。

回答No.1

ASIMOV

Sub TEST()
　　w = Selection.ColumnWidth
　　h = Selection.RowHeight
　　MsgBox "W=" & w & " H=" & h
End Sub

で、どうでしょう

お礼

ありがとうございます。
何をしたいかが伝えきれてませんでした。
前述のマクロはエクセルで縦横変倍可能な文字を使用したい為に考えたもので、
１、wordの起動
２、wordのマクロを使用して文字をコピー後終了
３、エクセルに形式を選択して貼付（ここまでは成功）
４、貼り付けたworddocumentのサイズをセルに合わせる（前述のマクロはセルにサイズを合わせる動作をマクロで記録したもの）
という工程で作りましたが最後のところを数値ではなく選択しているセルのサイズに合わせたいのです。

教えてもらったコードを参考にいろいろ試してみましたがやはりうまくいきません
３と４を合体させて下記のように直してみましたがサイズ変更は成功するものの選択したセルのサイズとはかけ離れた巨大なものが出来てしまします。
Sub 形式選択貼付()
H = Selection.Height
w = Selection.Width
ActiveSheet.PasteSpecial Format:="Microsoft Office Word 文書 オブジェクト", Link:=False, DisplayAsIcon:=False
Selection.ShapeRange.ScaleHeight w, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth H, msoFalse, msoScaleFromTopLeft
End Sub

解決方法はありませんでしょうか？