【エクセルVBA】シェイプのサイズとセルの縦横

マクロのインプット部分として、四角い図形を置けばそのサイズに合わせてセルの高さと幅を決めてくれるような処理を作りたいと思っています

基本的に四角いシェイプを選択した状態で開始するマクロで

Sub selectObjectsToArea()
　 targetAreaTop = Selection.Top
　 targetAreaLeft = Selection.Left
　 targetAreaRight = targetAreaLeft + Selection.Width
　 targetAreaBottom = targetAreaTop + Selection.Height
　
　 Workbooks.Add
　 Set testSheet = ActiveSheet
　 testSheet.Rows(1).RowHeight = targetAreaTop
　 testSheet.Columns(1).ColumnWidth = targetAreaLeft
　 testSheet.Rows(2) = targetAreaBottom - targetAreaTop
　 testSheet.Columns(2) = targetAreaRight - targetAreaLeft
end sub

これでtestSheetのB2セルが、もともとのシートの四角いシェイプの置いてあった位置と同じ位置、同じ大きさの四角…
になるつもりなのですが、なぜかかなり横に長い平たい四角になってしまいます
CentimetersToPoints関数というのがあるということを知ったのですが、これを使用しても比率が変わるだけ

エクセルの幅と高さをピクセルで指定するというページで
幅11.8ポイント：100ピクセル
高さ75ポイント：100ピクセル
というのがあったのですが、ピクセルとセンチの比率がわからず
調べているうちにその比率は解像度によって違ってくる…というような話がでてきて
どう整理してよいのかわからなくなってしまいました

シェイプの位置と大きさをセルの幅に変換する方法がわかる方がいらっしゃったらご指導をお願いいたします

No.2 ベストアンサー 回答者： cj_mover 回答日時： 2014/08/25 00:42

こんにちは。

セル範囲の列幅は、
ピクセル単位の .Width プロパティ（取得のみ可）で設定することは出来ず、
.ColumnWidth プロパティ（取得・設定可）で設定するしかありません。
この.ColumnWidth プロパティがなかなかの曲者で、

　１）Excelのオプション・基本設定で規定のフォント・フォントサイズ
　　　で決められている半角一文字のピクセル幅
　　　を参照して、列幅の算出方法が変わります。

　２）比較的大きな単位（フォントサイズ由来）でサイズを丸めてしまいます。

' ' 列幅が丸められる例（デフォルトのフォントサイズ：11の場合）
Sub check()
　　With Columns(2)
　　　　.ColumnWidth = 8.31
　　　　Debug.Print .ColumnWidth　　' →　 8.25
　　　　.ColumnWidth = 8.32
　　　　Debug.Print .ColumnWidth　　' →　 8.38
　　End With
End Sub

なので、残念ながら、そもそものExcelに備わった仕様として、
任意の座標やサイズを正確に、セル範囲にトレースすることは出来ません。
列幅値を計算で求めることはAPIを組み合わせれば可能ですが、
列幅を設定する時に大まかな丸めがあるので、
やるにしても、簡易に近似値を求めるのが妥当、ということです。
もし精度を求めるのであれば、セル範囲の座標とサイズで再現するのではなく、
何らかのシェープを使うのが現実的です。（その場合は変換する必要もないですね）
元々、Excel Worksheet に代表される SpreadSheet は、
細かなレイアウトを実現させるような目的で開発されていないのです。残念ながら。

大まかでもいいから、シェープからセル範囲へ座標とサイズをトレースしたい
ということで良ければと、
サンプルコードを（ご提示のコードを補完する形で）挙げておきます。
下記コード中
　(PixelX * 4 / 3 - 5) / 8
という計算の内、
" * 4 / 3" は、不変、
" - 5" や " / 8" は、フォントサイズ由来（フォントサイズ：11の場合）です。

Sub Re8728939()
　　Dim targetTop As Single
　　Dim targetLeft As Single
　　Dim targetRowHeight　As Single
　　Dim targetColumnWidth As Single

　　If TypeName(Selection) = "Range" Then MsgBox "四角い図形を選択後に実行": Exit Sub

　　On Error GoTo ErrOut_
　　With Selection
　　　　targetTop = .Top
　　　　targetLeft = (.Left * 4 / 3 - 5) / 8
　　　　targetRowHeight = .Height
　　　　targetColumnWidth = (.Width * 4 / 3 - 5) / 8
　　End With
　　On Error GoTo 0

　　Workbooks.Add
　　Rows(1).RowHeight = targetTop
　　Columns(1).ColumnWidth = targetLeft
　　Rows(2).RowHeight = targetRowHeight
　　Columns(2).ColumnWidth = targetColumnWidth

Exit Sub
ErrOut_:
　　MsgBox Err & vbLf & Err.Description
End Sub

＃参考URLは.ColumnWidthをテーマにした質問に以前お応えしたものです。

参考URL：http://oshiete.goo.ne.jp/qa/8490019.html

この回答へのお礼

詳しい回答ありがとうございます、できない仕様だとは思いませんでした

入力部分をこれで行おうと思っていたんですが、数値がきちんと取ってこれないと困るので、おっしゃる通りシェープでやってみるなど根本から考え直してみようと思います

お礼日時：2014/08/26 10:28

No.1 回答者： xls88 回答日時： 2014/08/24 22:34

下記で試してください。

targetAreaLeft = Selection.Left / 54 * 8.38

この回答へのお礼

一番の回答ありがとうございます

上の通りほかの方法でやってみることになってしまいました
またお世話になることがありましたらよろしくお願いします

お礼日時：2014/08/26 10:31