サッカーボールの型紙 ～ エクセルVBAで正六角形を作図しますPart 2

パッチワークで使うサッカーボールの型紙をExcelVBAで作図する方法のPart 2です。

エクセルのマクロで作図する方法として、正六角形に外接する円を六等分し、各点を結んで正六角形を作図するマクロをご紹介しました。
サッカーボールの型紙 ～ エクセルVBAで正六角形を作図します(2012年10月27日)

正六角形をExcelVBAで作図する方法Part 2では、正六角形の内角120°と外角60°から作図するマクロをご紹介します。



1.標準モジュールに下記のVBAコード(プログラム)を貼り付けてください。
　留意点は、角度計算にラジアンを使うこと、cm(mm)をポイントに変換して作図することの2点です。
　※VBAコードには、私の備忘録として多くのコメント（注釈）をつけました。
'ここから---------------------------------------------------------------------
Option Explicit
Sub 一辺がaの正6角形2()
Dim 正6角形 As Object
Dim a, x座標, y座標 As Double
'a = 一辺の長さ
Const PAI As Double = 3.14159265358979
'円周率 = PAI
'円周率は PAI = 4 * Atn(1)　又は
'ワークシート関数から　PAI = Application.WorksheetFunction.Pi PAI = WorksheetFunction.Pi() で求めることもできます
If MsgBox("選択したセルの左上を基点に正6角形を作図しますか？", vbYesNo) = vbNo Then Exit Sub
' 一辺がaの正6角形に外接する円の半径rを求める公式 … r=a/2sin(180/6)
a = Application.InputBox("一辺の長さは（cm単位、例4.5）", Type:=1) '数値を受け取る（数値以外は受け取れない）
a = a * 10 * 72 / 25.4 'ポイントへ変換… 1ポイント = 1インチ ÷ 72 = 25.4mm ÷ 72 = 0.353mm
'正6角形作図 (for next 配列を使って簡略化できます)
'選択セルの左上位置が点0
With ActiveCell
x座標 = .Left
y座標 = .Top
End With
Set 正6角形 = ActiveSheet.Shapes.BuildFreeform(msoEditingCorner, x座標, y座標)
'点1
x座標 = x座標 + a * Cos(60 * PAI / 180) 'ラジアンの計算 360°= 2 * PAI
y座標 = y座標 + a * Sin(60 * PAI / 180)
正6角形.AddNodes msoSegmentLine, msoEditingCorner, x座標, y座標
'点2
x座標 = x座標 - a + a * Cos(60 * PAI / 180)
y座標 = y座標 + a * Sin(60 * PAI / 180)
正6角形.AddNodes msoSegmentLine, msoEditingCorner, x座標, y座標
'点3
x座標 = x座標 - a
y座標 = y座標
正6角形.AddNodes msoSegmentLine, msoEditingCorner, x座標, y座標
'点4
x座標 = x座標 - a * Cos(60 * PAI / 180)
y座標 = y座標 - a * Sin(60 * PAI / 180)
正6角形.AddNodes msoSegmentLine, msoEditingCorner, x座標, y座標
'点5
x座標 = x座標 + a * Cos(60 * PAI / 180)
y座標 = y座標 - a * Sin(60 * PAI / 180)
正6角形.AddNodes msoSegmentLine, msoEditingCorner, x座標, y座標
'点6
With ActiveCell
x座標 = .Left
y座標 = .Top
End With
正6角形.AddNodes msoSegmentLine, msoEditingCorner, x座標, y座標
正6角形.ConvertToShape.Select
With Selection
.Placement = xlMove 'セルに合わせて移動するがサイズ変更はしない
.ShapeRange.LockAspectRatio = msoTrue '図形の縦横の比率を固定
.ShapeRange.Fill.Visible = msoFalse '塗りつぶしなし
.ShapeRange.Name = "正6角形" '図形の名前
.ShapeRange.Line.Weight = 0.75 '線の太さ
.ShapeRange.Line.ForeColor.ObjectThemeColor = msoThemeColorText1 '線の色=黒
End With
End Sub
'ここまで---------------------------------------------------------------------


1.正六角形の基点となる位置のセルを選択します。
　作成する正六角形の大きさにもよりますが、「I30」前後のセルを選択します。
3.マクロを実行すると、作成する正六角形の一辺の長さを入力する画面が表示されますので、任意の大きさを入力します。例えば5.5cm(55mm)の場合は5.5と入力します。
4.選択したセルの左上を基点とした正六角形が作図されます。
　※目印として選択したセルをオレンジ色にしました。
　・底辺が水平になるように作図は正六角形の右上の点(中心点から見て60°の位置)から始めます。
　・以下、時計回りで 5点の移動距離の座標を求めます。



5.作図した正六角形はワードで印刷した方が、寸法通りに印刷されます。
エクセルで印刷する場合は、拡大印刷が必要です。(我が家のプリンターは109％で寸法通りです)
パッチワークの型紙印刷は、エクセルそれともワード ～ 餅屋は餅屋で役割分担