エクセル 図形の寸法を取得したい

エクセル上に多数の四角が描かれており、これらの高さ、幅の平均値を計算したいと思います。どのようにしたら良いでしょうか？VBAでも構いません。

因みに、マクロの自動記録で「オートシェイプの書式設定→サイズ→高さ→コピー→（ワークシートのひとつのセルに）ペースト」を実施しましたが、記録されたのはペーストだけでした。

出来れば本日仕事で使えれば幸いです。宜しくお願い致します。

No.1 ベストアンサー 回答者： hana-hana3 回答日時： 2006/05/24 09:06

全てのシェイプを対象にしています。

Sub test1()

Dim Shap As Variant
Dim W As Single
Dim H As Single

For Each Shap In ActiveSheet.Shapes
'Debug.Print Shap.Height, " * ", Shap.Width
H = H + Shap.Height
W = W + Shap.Width
Next

H = H / ActiveSheet.Shapes.Count
W = W / ActiveSheet.Shapes.Count

MsgBox "高さの平均は、" & Round(H * 0.035277778, 3) & " cm" & vbLf & _
" 幅の平均は、" & Round(W * 0.035277778, 3) & " cm"

End Sub


http://hp.vector.co.jp/authors/VA016119/sizemmqa …

この回答へのお礼

朝早くからご指導頂き誠に有り難うございました。
dim、図形属性の読み込み方など勉強になりました。
仕事の方も目途が立ちました。
もし次の機会が有りましたら、また宜しくお願い申し上げます。

お礼日時：2006/05/24 19:23

No.2 回答者： merlionXX 回答日時： 2006/05/24 11:28

シェープのうち、オートシェープのみを対象にし、シート上に幅、高さ、名前を表示させるマクロです。

シェープに特に名前をつけていなければ、四角形は　Rectangle ○←番号　という名前になっていますから識別できます。
下記のコードをちょっといじれば、最初からRectangleだけを抽出もできますね。

Sub test()
n = 1
For Each sh In ActiveSheet.Shapes
If sh.Type = msoAutoShape Then
Cells(n, 1) = sh.Height
Cells(n, 2) = sh.Width
Cells(n, 3) = sh.Name
n = n + 1
End If
Next
End Sub

この回答へのお礼

ご指導大変有り難うございました。
ワークシート上に個々の値が出力されるので、統計処理も出来そうです。
今後も宜しくお願い申し上げます。

お礼日時：2006/05/24 19:28