PR

Excel VBAでオートシェープ図形のサイズを書式サイズに合わせて計算する

Excel VBA Tips
この記事は約8分で読めます。

「Excel VBA Tips」ではExcel VBAを使用していて気付いたことを取り上げて行きます。

今回はオートシェープ図形のサイズをVBAで取得して図形の書式サイズに表示される値にするための計算式について記載いたします。

なお計算式はあくまでも試行錯誤により導き出したもので裏付けはない事をお含み置きいただければ幸いです。

Excel 2016バージョン2010(ビルド 13328.20292)を使用しています。

スポンサーリンク

ExcelのShapeオブジェクトにあるHeightとWidthのプロパティ―

ExcelのShapeオブジェクトには「オートシェープ、フリーフォーム、OLE オブジェクト、図などの描画オブジェクト」[1]が含まれています。

従いまして「オートシェープ図形」以外に「図」のサイズも同様に計算する事ができます。

[1]–Microsoft Docs Shapeオブジェクト:https://docs.microsoft.com/ja-jp/office/vba/api/excel.shape

Shapeオブジェクトのプロパティ―は沢山ありますが、その中のHeightプロパティ―とWidthプロパティ―でオブジェクトの高さと幅の値を取得または設定することができます。

この両者のプロパティ―の値は「ポイント」単位であり、データ型は単精度浮動小数点型になります。[2]

[2]–Microsoft Docs Height/widthプロパティ―:https://docs.microsoft.com/ja-jp/office/vba/api/excel.shape.heighthttps://docs.microsoft.com/ja-jp/office/vba/api/excel.shape.width

上記参照リンクに設定されている用語集を見ると「1ポイントは1/72インチ」と書かれています。

従って、プロパティ―で取得した値を図形の書式サイズに変換するためにやらなければならない事は下記2点になります。

  1. ポイントをセンチメートルに変換する。
  2. 単精度浮動小数点型をセンチメートル単位で小数点以下2桁に四捨五入する。
    • Excelの図形の書式サイズは「X.XX cm」形式で表示されています。

ポイントをセンチメートルに単位変換する

「1ポイントは1/72インチ」なのですが、「1インチは何cm」になるか?が問題です。

下記サイトを見ると「インチからミリメートルへ変換する式」が掲載されていますが、1インチは1/0.03937ミリメートルになるようです。

そうなりますと「1ポイントをセンチメートルに変換するための式」はつぎのようになります。

ポイント = (1 / 72) * (1 / 0.039370) * (1 / 10) センチメートル

最後に1/10を掛けているのはミリメートルをセンチメートルに変換するためです。

計算値としては「0.0352778483334744…」になりますが、Shapeオブジェクトのプロパティ―で取得されるデータのデータ型単精度浮動小数点型にそろえるのであれば、有効桁数は7桁目ぐらいになるでしょうか?

という事でまずは「0.03527784」を変換係数に使って、計算結果は小数点以下3桁目で四捨五入する仕様で計算式を作成する事にします。

上記を実装したVBAコーディングは下記になります。

Sub ShapeSize()
Dim Shp As Shape
  For Each Shp In ActiveSheet.Shapes
    Debug.Print Shp.Name & ", " & Shp.Height * 0.03527784 & " cm × " & Shp.Width * 0.03527784 & " cm"
    Debug.Print Shp.Name & " " & Int((Shp.Height * 0.03527784 + 0.005) * 100) / 100 & " cm × " & Int((Shp.Width * 0.03527784 + 0.005) * 100) / 100 & " cm"
  Next Shp
End Sub
  1. VBAのRound関数は「銀行の丸め」と呼ばれる2で割り切れる数値に加工して値を返す[3]ためint関数を使用して四捨五入しています。
    • 具体的には計算値に0.005を加算した後、int関数で切り捨て処理します。
  2. 計算対象の値はプラスに限定されるのですが、念のために計算値に100を掛け整数化してから切り捨て処理をするようにしています。最後に100で割って位取りをもとに戻します。
  3. 計算結果の出力先はイミディエイトウィンドウにしています。

上記コーディングをThisWorkbookオブジェクトに貼り付けて実行すると、フォーカスの当たっているワークシートに配置されたすべてのオブジェクト図形のサイズを「1行目は四捨五入しない値」、「2行目は小数点以下3桁目で四捨五入した値」が、イミディエイトウィンドウに出力されます。

[3]–Microsoft Docs Round 関数:https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/round-function

「二段階での四捨五入」仮説

いろいろなオブジェクト図形に対して上記コーディングを実行してみると、計算値と図形の書式サイズの値には差が発生する場合があることが解ります。

ただし差が発生する場合の四捨五入しない値を調べてみると規則性があることが解ります。

上図は標準のRectangleとIsosceles Triangleになりますが、サイズを直接入力するのでなく意図的に調整しています。具体的には一旦別サイズで入力をした後に、倍率を変更して微妙なサイズに加工しています。従いまして標準オートシェープ図形を普通に使うのであればこのような差は生じない認識です。

「前章のコーディングの実行結果」と「図形の書式サイズ」で四捨五入した値は次のようになります。

図形計算値の「高さ」書式サイズの「高さ」計算値の「幅」書式サイズの「幅」
Rectangle2.112.121.261.27
Isosceles Triangle2.092.091.161.17

Isosceles Triangleの高さ以外は書式サイズの高さに+0.01の差が発生しています。

この要因ですが、四捨五入していない結果を見ていただくと分かるのですが、小数点以下3桁目と4桁目が「45・48・49」の時は+0.01の差が出るのに対して、「44」の時は差は出ていません。

そうなりますと考えられる仕様としては「図形の書式サイズを一旦小数点以下4桁目で四捨五入した後に再度小数点以下3桁目で四捨五入計算している」のではないか?と推察されます。

残念ながらなぜこのような仕様にしているのか?その意図は分かりませんが、状況的には「二段階での四捨五入仮説」が濃厚です。

ポイント・センチメートルの変換係数の微調整

弊社は地図のオートシェープ図形を製作しているのですが、作成の都度この計算式を使用してサイズを確認しているのですが、二段階での四捨五入にコーデングを修正した後はコーディングによる計算値と図形の書式サイズの差は出なくなりました。

ただし実際に使用していると1000個に1個ぐらいの割合で差がでる場合がありました。その1つが「愛媛県伊予郡砥部町」のオートシェープ図形になります。

上図で、図形の書式サイズは「5.8cm×2.59cm」であるのに対して、当初の変換係数「0.03527784」を使用した場合では計算値は「5.81cm×2.59cm」と高さに+0.01の差が生じてしまいます。

そこで変換係数の桁数を7桁から6桁に減少させたのが上図青枠の計算値で、変換係数が「0.0352778」であれば図形の書式サイズと一致することが解りました。

なかなか小数点以下7桁目の有無によって、小数点以下2桁目の値に影響するというのは考え難いのですが、四捨五入していない数値を見ていただくと分かるのですが「二段階での四捨五入」仮説から小数点以下5桁目の影響が小数点以下2桁目に反映しているようなので、「さもありなん」と言ったところでしょうか?

以上の結果から最終的なVBAコーディングは下記のようになります。

Sub ShapeSize()
Dim Shp As Shape
  For Each Shp In ActiveSheet.Shapes
    Debug.Print Shp.Name & " " & Int((Int((Shp.Height * 0.0352778 + 0.0005) * 1000) / 1000 + 0.005) * 100) / 100 & " cm × " & Int((Int((Shp.Width * 0.0352778 + 0.0005) * 1000) / 1000 + 0.005) * 100) / 100 & " cm"
  Next Shp
End Sub
  1. 対象のワークシートを選択してから、VBAコーディングを実行してください。
  2. xlsx形式でも上記コーディングをショートカットメニューの「コードの表示」に貼り付けて実行することはできます。
    • ただし、その場合は貼り付けたSheetオブジェクトに対しての実行になります。
    • 詳細なご説明は別のTipsで公開いたします。

なお四捨五入していない値は検証が主な目的のため、上記コーディングでは除外しています。

最後に

一応前章の最終的なVBAコーディングを使用して1,000個ぐらい計算をしていますが差は生じていない状況です。

ただし冒頭で「計算式はあくまでも試行錯誤により導き出したもので裏付けはない」と書きましたが、状況証拠の積み上げで作られた代物です。

従いまして、弊社でも計算結果と図形の書式サイズに差がないかを逐次確認をして使用しています。

そのため、もしもご利用いただく際には結果を確認していただきますようお願い申し上げます。

以上最後までご一読いただき誠にありがとうございました。