エクセルVBAプログラミング練習帳。レシピ作成と連動するオートシェイプを利用したPFCバランスグラフ作成。

練習帳ファイルのダウンロード
1. PFCグラフダウンロード
PFCバランスグラフの概要
ちょっとその前にレシピの使い方
1. レシピに食材を追加するには
PFCバランスグラフをエクセルで表現する
グラフ作成原理（グラフ表現構成要素）
1. ④理想的エネルギー比率図
  1. PFCの各値を取り出す
2. 作図の実際
あとがき

練習帳ファイルのダウンロード

PFCグラフダウンロード

1 ファイル 275.49 KB

ダウンロード

ダウンロードはこちらからもできます。

ダウンロードファイルはZIPで圧縮しています。解凍して使用してください。PFCグラフ　フォルダーにあるitem3 はCSVファイルでPCFグラフで試用する食材の栄養価データが約2000件入っています。
item3はPFCグラフと同じフォルダー内で動作するように設定されていますから、PFCグラフと切り離して別のフォルダーに移動したりしないでください。

PFCバランスグラフの概要

PFCとは、3大栄養素に当たるタンパク質（Protein）脂質（Fat）炭水化物（Carbohydrate）の頭文字をとった言葉です。

そして、PFCバランスとは摂取カロリーのうち3大栄養素がそれぞれどれくらいの割合を占めるかの比率のことを指します。

バルクアップあるいは減量など、それぞれに適切なPFCバランスが存在します。目的に応じてPFCバランスを意識しながら食事をコントロールをすることで、理想の体型を目指しやすくなります。

身体を変えるためには、トレーニングがもちろん欠かせませんが、食事はそれ以上に重要な要素です。筋トレの成果をしっかりと出したいのであれば、摂取カロリーとPFCバランスを意識した食事をしてみましょう。

（https://valx.jp/column/1447　記事中から参照）

代表的なグラフのイメージ

ちょっとその前にレシピの使い方

PFCグラフを表示する元になるデータを準備しなければなりません。

ダウンロードファイルを解凍したら「PFCグラフ」エクセルファイルを開きます。

最初に開くと上のほうに黄色のセキュリティ警告がでます。
その右側にある「コンテンツの有効化」ボタンをクリックします。

レシピに食材を追加するには

二種類あります。

例１　E列、項目　食材名の16行目以降のセルをダブルクリックする。

例２　E列、項目　食材名の16行目以降のセルに直接追加したい食材の名前の一部を入力してエンターキーを押す。

どちらの例でも食材検索ボックスが表示します。下の例では例２の場合で、セルに”じゃが”と入力して表示されたフォームです。

例１の場合は検索ボックスのテキスト入力エリアに希望する食材名の一部を入力して「検索」ボタンをクリックします。例２の場合はそのまま「検索」ボタンをクリックします。
テキスト入力エリアは、コンボボックスになっていて検索結果をローソースリストにして表示します。

リストの中から希望する食材を見つけてその行をクリックします。

食材の使用量を入力するボックスが開くので、一人前の使用する分量をグラム（ｇ）単位で入力して「OK」ボタンをおします。

選んだ食材の単価や加工方法のほか様々な情報入力するボックスが開くので適当に入力して「登録」ボタンを押します。★項目は必須ですが、正確な数値を入力する必要はありませんから適当にします。

食材itemにはあらかじめ単価情報があるものと無いものが混在しています。単価情報が無いものは下の図のように赤で表示されます。

食材リストにあらかじめ登録がされていないので赤で注意が促されます。
その場合は入力しないと登録できません。

下のフォームの例では、★規格単位を”個”に設定したので、★規格当たりg数を”50”として★単価は”35”と入力しました。準備（発注）量は自動的に計算されます。登録ボタンが使えるようになるので登録します。次回からこの食材を選択したときには今登録した単価情報が入力された状態で表示されます。

単価情報入力の時、★規格単位がｋ（㎏）の時は★規格当りｇ数はいつも1000となり一キロ当たりの価格を入力すればいいのであまり問題はないのですが、この例のコロッケなどのように単位が個や枚などの場合はちょっと注意が必要です。単位が個なら当然一個当りのｇ数を入力し、単価も一個当たりの価格を入力します。でも使用量（ｇ）は１個ではなく一個当たりのｇ数　”50”と入力しますが準備発注量は100個と計算表示されます。使用量はいつもｇ単位ですが、単価情報は規格の単位で決まります。

加工情報は必要なければ空白で大丈夫です。例えば食材が玉葱だったりする場合はその食材の仕込みや準備の情報を入れておきます。ここは、コンボボックスであらかじめサイズや形状などリスト表示するのでその中から選択します。リストに希望するものが無いときは直接書き込むことが可能です直接入力したときは次回からリストに追加されるようになっています。

使用量(ｇ)は変更する必要がある場合は後から直接セルに書き込んでも大丈夫です。必須項目以外は空白でも大丈夫です。後から入力しても大丈夫です。（加工の項目列のセルをダブルクリックすると入力ボックスが出ます）

レシピにはサンプルデータがすでにいくつか入力済みですから適当にやってみてください。

必要ない食材は、食材名の項目でDELETEキーを押すと一行分削除できます。（全部の行を一度に消すことはできません。今のところ。）

それではレシピの説明はこのくらいにして今回のテーマ、グラフの説明にはいりますから引き続きお付き合いの程よろしくお願いします。

PFCバランスグラフをエクセルで表現する

エクセルでグラフを作るには様々にあると思います。と、すぐに思いつくのがエクセルが標準で備えている棒グラフ、折れ線グラフなど作成機能です。これらの中からPFCグラフに近いものにレーダーチャート形式グラフがあったので、これを利用しようと色々やってみましたがどうもうまくいきません。

次に思いついたのが、直線や円を描画するオートシェイプ。これなら少し手間がかかりますが自由度が高く表現できるだろうと考えた。

まず、直線を引く様子をマクロで記録して、VBAがオートシェイプを作成する様子を観察することにします。

エクセルでセルにある数値データの変化をどのようにしてオートシェイプの変化にするかを確認してみます。

マクロの取り方

①　エクセル本体のメニュータブ→表示→マクロ→マクロの記録をクリック

下のダイアログが開くので、そのまま「OK」ボタンを押します。
この操作以降に行うエクセルでの作業はすべてマクロに記録されます。

②それでは、開いているシートの上にオートシェイプの直線を引いてみます。
メニュータブの挿入→図形→直線アイコンを選択します。

下図左側の赤矢印のように、横一直線に黒い直線を引いてみます
そのあと、下図右側のようにマクロ→記録終了をクリックします

次に、キーボードからAltキー＋F8キーを押すと下図のようにダイアログが開くので右側中央付近にある編集ボタンをクリックします。

次に、②で描画した直線のオートシェイプの様子が記録されたVBAのコードエディター画面が表示されます。下図では　Sub　Macro1（）から始まった1２行のプログラムコードが表示されています。

直線を引くマクロのコードの様子

赤丸で示した行の一文が直線を引くコマンドになります。ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 62.4, 46.2, 270.6, 46.2).Select

上文の右側の数値が並んでいる部分　62.4 , 46.2 , 270.6 , 46.2　の部分が直線をどこから何処まで引くかを表しています。数値の並びの左側から62.4が直線の開始位置のX座標、46.2が開始位置のY座標、270.6が終了位置のX座標、46.2が終了位置のY座標になっています。

これを、実際に直線が描画されている下図の様子と合わせてみると、この文の意味が分かると思います。

ワークシートの直線と座標の関係

開いているワークシートのA1のセルの左上の角の座標（X,Y）＝（0,0）になっているようです。

シートの左端から右側横（X軸）方向に、また　上端から下に向かった（Y軸）方向に数値が変化することで直線が描画できるんです。（この数値はピクセルという単位の様です）

つまり、この数値をプログラムで変化させれば直線の長さや位置を動的に変化させることができるようだということが分かります。

ここまでのことで、PFCグラフという特殊なグラフを作るのにはオートシェイプの直線を利用すれば作成できそうです。

グラフ作成原理（グラフ表現構成要素）

④理想的エネルギー比率図

以上の要素をグラフで表現します。下図はワークシートのレシピ例の最上部の朝食レシピの栄養素の合計結果を表しています（各食品名等は省略）

★図表摂取栄養（リンクからここに来たときは元の記事に戻る）

PFCの各値を取り出す

①摂取総熱量（kcal）445.1
②3大栄養素摂取量　P-蛋白質18.3、F-脂質12.2、C-炭水化物62.3
③　②のそれぞれの値を熱量値に換算するための係数（P=4kcal、F=9kcal、C=4kcal）

④熱量換算値と総熱量対比率
P＝18.3×4kcal＝73.2kcal　÷　445.1＝16.4％
F=12.2×9kcal＝109.8kcal　÷　445.1＝24.7％
C=62.3×4kcal＝249.2kcal　÷　445.1＝56.0％
となりましたから下図の理想的な栄養バランス比率の範囲内にあることが分かります

円の半径を理想値として計算結果の比率を直線の長さに変換して落とし込んでいけばいいのだと思います。

作図の実際

本システムではSheet2に各設定値をセットしています。システム中でこの設定値を参照しているので設定しているセルを移動したり、又　シート中の列や行を追加したり削除したりしないでください

蛋白質のエネルギー換算後の比率　18.3ｇ×４kca÷445.1kcal＝0.164≒16%
脂質のエネルギー換算後の比率　12.2ｇ×9kcal÷445.1kcal＝0.246≒25％
炭水化物のエネルギー換算後の比率　62.3ｇ×4kcal÷445.1kcal＝0.559≒56％

グラフでは上記の実際のレシピから得た計算結果を④の理想的なエネルギー比率と比較表現します。

④の図形では円の中心から正三角形の各頂点に向かって放射状に延びる直線をそれぞれP、F、Cとしています。つまり、円の半径が理想的エネルギー比率の100%値で各直線の長さが実際に摂取したエネルギー比率となります。各直線が円の半径以内であれば不足、円の外に突き出た場合は過多ということです。

④の図では例えば蛋白質では13%～20%と幅がありますからこのうちどの値を取るかで計算結果に若干の差が出ますので、事業所等で利用するときは注意が必要です

それでは、具体的にグラフの作成に取り掛かりましょう。
ワークシートには１日の食事帯カテゴリー朝食、昼食、選択食、おやつ、夕食の５つのレシピーがセットしてありそれぞれのレシピごとに１個のグラフが表示され、最上部に一日の総合計のグラフを表示するようにしています。それぞれのレシピ内容が更新される都度、グラフ描画が更新するようになっています。

グラフ描画の基本情報を取り込んで描画するプロシージャを呼び出す

Public Sub gurafukousinn(hankeidataiti As Integer, goukeiiti As Integer)
'hankeidataitiはシート2の朝食等カテゴリーごとの円図形の位置情報
'goukeiitiは　シート１のカテゴリーごとの集計合計行を示す数値

Dim sitennX As Single
Dim sitennY As Single

Dim hankei As Single
Dim ennleft As Single
Dim enntop As Single

Dim E As Integer
Dim P As Single
Dim F As Single
Dim C As Single

'グラフ位置
hankei = Sheet2.Cells(hankeidataiti, 4)
ennleft = Sheet2.Cells(hankeidataiti + 1, 4)
enntop = Sheet2.Cells(hankeidataiti + 2, 4)
'栄養価データ取得
E = Sheet1.Cells(goukeiiti, 16)
P = Sheet1.Cells(goukeiiti, 19)
F = Sheet1.Cells(goukeiiti, 21)
C = Sheet1.Cells(goukeiiti, 23)
'熱量換算計算
P = P * Sheet2.Range("I4")  '4kcal
F = F * Sheet2.Range("I5")  '9kcal
C = C * Sheet2.Range("I6")  '4kcal

'円の中心点（長さの始点）のｘ座標
sitennX = ennleft + hankei
'円の中心点（長さの始点）のｙ座標
sitennY = enntop + hankei
'====================================================================
Select Case goukeiiti
    Case 56
        '朝食
        Call zukeibyouga("asa", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)
    Case 97
        '昼食A
        Call zukeibyouga("hiruA", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)
    Case 138
        '昼食B
        Call zukeibyouga("hiruB", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)
    Case 179
        'おやつ
        Call zukeibyouga("oyatu", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)
    Case 220
        '夕食
        Call zukeibyouga("yuu", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)
    Case 221
        '総合
        Call zukeibyouga("sougou", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)
End Select



End Sub

Public Sub gurafukousinn(hankeidataiti As Integer, goukeiiti As Integer)

'hankeidataitiはシート2の朝食等カテゴリーごとの円図形の位置情報

'goukeiitiは　シート１のカテゴリーごとの集計合計行を示す数値

Dim sitennX As Single

Dim sitennY As Single

Dim hankei As Single

Dim ennleft As Single

Dim enntop As Single

Dim E As Integer

Dim P As Single

Dim F As Single

Dim C As Single

'グラフ位置

hankei = Sheet2.Cells(hankeidataiti, 4)

ennleft = Sheet2.Cells(hankeidataiti + 1, 4)

enntop = Sheet2.Cells(hankeidataiti + 2, 4)

'栄養価データ取得

E = Sheet1.Cells(goukeiiti, 16)

P = Sheet1.Cells(goukeiiti, 19)

F = Sheet1.Cells(goukeiiti, 21)

C = Sheet1.Cells(goukeiiti, 23)

'熱量換算計算

P = P * Sheet2.Range("I4") '4kcal

F = F * Sheet2.Range("I5") '9kcal

C = C * Sheet2.Range("I6") '4kcal

'円の中心点（長さの始点）のｘ座標

sitennX = ennleft + hankei

'円の中心点（長さの始点）のｙ座標

sitennY = enntop + hankei

'====================================================================

Select Case goukeiiti

Case 56

'朝食

Call zukeibyouga("asa", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)

Case 97

'昼食A

Call zukeibyouga("hiruA", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)

Case 138

'昼食B

Call zukeibyouga("hiruB", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)

Case 179

'おやつ

Call zukeibyouga("oyatu", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)

Case 220

'夕食

Call zukeibyouga("yuu", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)

Case 221

'総合

Call zukeibyouga("sougou", hankei, ennleft, enntop, sitennX, sitennY, E, P, F, C)

End Select

End Sub

まず、グラフの基本構造を形作るプロシージャです。

36行目以降がグラフの全体像を描画するプロシージャのコードです。

Private Sub zukeibyouga(kategori As String, hankei As Single, _
                        ennleft As Single, enntop As Single, _
                        sitennX As Single, sitennY As Single, _
                        E As Integer, P As Single, F As Single, C As Single)
Dim enn As Variant
Dim pro As Variant
Dim fat As Variant
Dim crb As Variant
'Dim sacl As Variant
Dim ketu1 As Variant
Dim ketu2 As Variant
Dim ketu3 As Variant

'データ取り出し


'図形があるかチェックしてあれば削除する
If Sheet1.Shapes.Count > 1 Then
    '削除
    Dim zukei As Shape
    For Each zukei In Sheet1.Shapes
        If zukei.name = "enn_" & kategori _
            Or zukei.name = "pro_" & kategori _
            Or zukei.name = "fat_" & kategori _
            Or zukei.name = "crb_" & kategori _
            Or zukei.name = "ketu1_" & kategori _
            Or zukei.name = "ketu2_" & kategori _
            Or zukei.name = "ketu3_" & kategori Then
            zukei.Delete
        End If
    Next
End If


'円の描画
Set enn = ActiveSheet.Shapes.AddShape(msoShapeOval, ennleft, enntop, hankei * 2, hankei * 2) 'shapes(2) asa円
enn.Fill.ForeColor.RGB = RGB(230, 230, 250) 'ラベンダー
enn.name = "enn_" & kategori

'プロテイン長さを描画
If E = 0 Then Exit Sub
Dim syuuten As Variant
syuuten = syuutenXY(E, P, "p", hankei, ennleft, enntop)
PsyuutenX = syuuten(0)
PsyuutenY = syuuten(1)
Set pro = ActiveSheet.Shapes.AddLine(sitennX, sitennY, PsyuutenX, PsyuutenY) 'shapes(3)　プロテイン
'直線の色、太さ指定
pro.line.ForeColor.RGB = RGB(0, 255, 0) 'green
pro.line.Weight = 1
pro.name = "pro_" & kategori

'脂質
syuuten = syuutenXY(E, F, "f", hankei, ennleft, enntop)
FsyuutenX = syuuten(0)
FsyuutenY = syuuten(1)
Set fat = ActiveSheet.Shapes.AddLine(sitennX, sitennY, FsyuutenX, FsyuutenY) 'shapes(4)　ファット
fat.line.ForeColor.RGB = RGB(0, 0, 255) 'blue
fat.line.Weight = 1
fat.name = "fat_" & kategori

'炭水化物
syuuten = syuutenXY(E, C, "c", hankei, ennleft, enntop)
CsyuutenX = syuuten(0)
CsyuutenY = syuuten(1)
Set crb = ActiveSheet.Shapes.AddLine(sitennX, sitennY, CsyuutenX, CsyuutenY) 'shapes(5)　カーボン
crb.line.ForeColor.RGB = RGB(255, 165, 0) 'orange
crb.line.Weight = 1
crb.name = "crb_" & kategori

'各頂点を結線して三角形を描画
Set ketu1 = ActiveSheet.Shapes.AddLine(PsyuutenX, PsyuutenY, FsyuutenX, FsyuutenY) '結線１
ketu1.name = "ketu1_" & kategori
Set ketu2 = ActiveSheet.Shapes.AddLine(FsyuutenX, FsyuutenY, CsyuutenX, CsyuutenY) '結線2
ketu2.name = "ketu2_" & kategori
Set ketu3 = ActiveSheet.Shapes.AddLine(CsyuutenX, CsyuutenY, PsyuutenX, PsyuutenY) '結線3
ketu3.name = "ketu3_" & kategori

'ｐｆｃ吹き出し項目の位置決め
If kategori = "sougou" Then
    Call fukidasiiti(PsyuutenX - 30, PsyuutenY - 30, FsyuutenX + 10, FsyuutenY, CsyuutenX - 70, CsyuutenY + 10)
End If

End Sub

Private Sub zukeibyouga(kategori As String, hankei As Single, _

ennleft As Single, enntop As Single, _

sitennX As Single, sitennY As Single, _

E As Integer, P As Single, F As Single, C As Single)

Dim enn As Variant

Dim pro As Variant

Dim fat As Variant

Dim crb As Variant

'Dim sacl As Variant

Dim ketu1 As Variant

Dim ketu2 As Variant

Dim ketu3 As Variant

'データ取り出し

'図形があるかチェックしてあれば削除する

If Sheet1.Shapes.Count > 1 Then

'削除

Dim zukei As Shape

For Each zukei In Sheet1.Shapes

If zukei.name = "enn_" & kategori _

Or zukei.name = "pro_" & kategori _

Or zukei.name = "fat_" & kategori _

Or zukei.name = "crb_" & kategori _

Or zukei.name = "ketu1_" & kategori _

Or zukei.name = "ketu2_" & kategori _

Or zukei.name = "ketu3_" & kategori Then

zukei.Delete

End If

'円の描画

Set enn = ActiveSheet.Shapes.AddShape(msoShapeOval, ennleft, enntop, hankei * 2, hankei * 2) 'shapes(2) asa円

enn.Fill.ForeColor.RGB = RGB(230, 230, 250) 'ラベンダー

enn.name = "enn_" & kategori

'プロテイン長さを描画

If E = 0 Then Exit Sub

Dim syuuten As Variant

syuuten = syuutenXY(E, P, "p", hankei, ennleft, enntop)

PsyuutenX = syuuten(0)

PsyuutenY = syuuten(1)

Set pro = ActiveSheet.Shapes.AddLine(sitennX, sitennY, PsyuutenX, PsyuutenY) 'shapes(3)　プロテイン

'直線の色、太さ指定

pro.line.ForeColor.RGB = RGB(0, 255, 0) 'green

pro.line.Weight = 1

pro.name = "pro_" & kategori

'脂質

syuuten = syuutenXY(E, F, "f", hankei, ennleft, enntop)

FsyuutenX = syuuten(0)

FsyuutenY = syuuten(1)

Set fat = ActiveSheet.Shapes.AddLine(sitennX, sitennY, FsyuutenX, FsyuutenY) 'shapes(4)　ファット

fat.line.ForeColor.RGB = RGB(0, 0, 255) 'blue

fat.line.Weight = 1

fat.name = "fat_" & kategori

'炭水化物

syuuten = syuutenXY(E, C, "c", hankei, ennleft, enntop)

CsyuutenX = syuuten(0)

CsyuutenY = syuuten(1)

Set crb = ActiveSheet.Shapes.AddLine(sitennX, sitennY, CsyuutenX, CsyuutenY) 'shapes(5)　カーボン

crb.line.ForeColor.RGB = RGB(255, 165, 0) 'orange

crb.line.Weight = 1

crb.name = "crb_" & kategori

'各頂点を結線して三角形を描画

Set ketu1 = ActiveSheet.Shapes.AddLine(PsyuutenX, PsyuutenY, FsyuutenX, FsyuutenY) '結線１

ketu1.name = "ketu1_" & kategori

Set ketu2 = ActiveSheet.Shapes.AddLine(FsyuutenX, FsyuutenY, CsyuutenX, CsyuutenY) '結線2

ketu2.name = "ketu2_" & kategori

Set ketu3 = ActiveSheet.Shapes.AddLine(CsyuutenX, CsyuutenY, PsyuutenX, PsyuutenY) '結線3

ketu3.name = "ketu3_" & kategori

'ｐｆｃ吹き出し項目の位置決め

If kategori = "sougou" Then

Call fukidasiiti(PsyuutenX - 30, PsyuutenY - 30, FsyuutenX + 10, FsyuutenY, CsyuutenX - 70, CsyuutenY + 10)

End If

End Sub

☆下のコードは図形を描画するとき栄養価の値を直線の長さを表現するため直線描画の終点の座標を計算してその結果を返すファンクションプロシージャです。
上のzukeibyougaプロシージャの　43行目、
syuuten = syuutenXY(E, P, “p”, hankei, ennleft, enntop)で呼び出されて終点座標を入れた配列を返してきます。

座標値を返すファンクションプロシージャ

Public Function syuutenXY(E As Integer, eiyouti As Single, kategori As String _
                            , hankei As Single, ennleft As Single, enntop As Single) As Variant
'栄養価の値から図形の直線の終点座標を求めて配列にして返す（配列（０）がx座標（１）がy座標）
'第一引数　E=総エネルギー
'第二引数　eiyouti 現在の実際の栄養数値
'第三引数　kategori P=蛋白質　F=脂質　C=炭水化物

Dim xy(1) As Variant

Dim Pnagasa As Single
Dim Fnagasa As Single
Dim Cnagasa As Single

'栄養価量の換算熱量
Dim kanP As Single
Dim kanF As Single
Dim kanC As Single
Dim kijunP As Single
Dim kijunF As Single
Dim kijunC As Single

Select Case kategori
    Case "P", "p"
        kanP = eiyouti  '現在熱量換算値
        kijunP = E * Sheet2.Cells(4, 8)   '蛋白質２０％ 基準栄養換算熱量
        Pnagasa = kanP * hankei / kijunP
        '--------------------------------------
        xy(0) = ennleft + hankei 'x座標
        xy(1) = enntop + (hankei - Pnagasa) 'y座標
        If xy(1) < 0 Then
            xy(1) = 0
        End If
        'ファンクションに返す
        syuutenXY = xy
    Case "F", "f"
        kanF = eiyouti
        kijunF = E * Sheet2.Cells(5, 8)    '脂質　３０％
        Fnagasa = kanF * hankei / kijunF
        '------------------------円の中心から右側なので半径にプラス--------------
        xy(0) = ennleft + (hankei + (Fnagasa / 2 * Sqr(3))) 'x
        xy(1) = enntop + hankei + (Fnagasa / 2) 'y
        'ファンクションに返す
        syuutenXY = xy

    Case "C", "c"
        kanC = eiyouti
        kijunC = E * Sheet2.Cells(6, 8)   '炭水化物６５％
        Cnagasa = kanC * hankei / kijunC
        '-------------------------円の中心から左側なので半径からマイナス------------
        xy(0) = ennleft + (hankei - (Cnagasa / 2 * Sqr(3))) 'x
        xy(1) = enntop + hankei + (Cnagasa / 2) 'y
        'ファンクションに返す
        syuutenXY = xy
End Select

End Function

Public Function syuutenXY(E As Integer, eiyouti As Single, kategori As String _

, hankei As Single, ennleft As Single, enntop As Single) As Variant

'栄養価の値から図形の直線の終点座標を求めて配列にして返す（配列（０）がx座標（１）がy座標）

'第一引数　E=総エネルギー

'第二引数　eiyouti 現在の実際の栄養数値

'第三引数　kategori P=蛋白質　F=脂質　C=炭水化物

Dim xy(1) As Variant

Dim Pnagasa As Single

Dim Fnagasa As Single

Dim Cnagasa As Single

'栄養価量の換算熱量

Dim kanP As Single

Dim kanF As Single

Dim kanC As Single

Dim kijunP As Single

Dim kijunF As Single

Dim kijunC As Single

Select Case kategori

Case "P", "p"

kanP = eiyouti '現在熱量換算値

kijunP = E * Sheet2.Cells(4, 8) '蛋白質２０％基準栄養換算熱量

Pnagasa = kanP * hankei / kijunP

'--------------------------------------

xy(0) = ennleft + hankei 'x座標

xy(1) = enntop + (hankei - Pnagasa) 'y座標

If xy(1) < 0 Then

xy(1) = 0

End If

'ファンクションに返す

syuutenXY = xy

Case "F", "f"

kanF = eiyouti

kijunF = E * Sheet2.Cells(5, 8) '脂質　３０％

Fnagasa = kanF * hankei / kijunF

'------------------------円の中心から右側なので半径にプラス--------------

xy(0) = ennleft + (hankei + (Fnagasa / 2 * Sqr(3))) 'x

xy(1) = enntop + hankei + (Fnagasa / 2) 'y

'ファンクションに返す

syuutenXY = xy

Case "C", "c"

kanC = eiyouti

kijunC = E * Sheet2.Cells(6, 8) '炭水化物６５％

Cnagasa = kanC * hankei / kijunC

'-------------------------円の中心から左側なので半径からマイナス------------

xy(0) = ennleft + (hankei - (Cnagasa / 2 * Sqr(3))) 'x

xy(1) = enntop + hankei + (Cnagasa / 2) 'y

'ファンクションに返す

syuutenXY = xy

End Select

End Function

このプロシージャのみそは40と41行目です。

xy(0) = ennleft + (hankei + (Fnagasa / 2 * Sqr(3))) ‘x

xy(1) = enntop + hankei + (Fnagasa / 2) ‘y

三平方の定理

何をやっているかというと、下図はAndroidのCanvasで作った時のものですが、エクセルでも考え方は全く同じなので、下図で説明します

まず、グラフのエネルギー比率の100％を表す円の中心から円周に向かって伸びる各直線と円周が交わる点を直線PF、PC、CFは正三角形を形成します。又、中心から三角形の頂点に向かって伸びる各直線OP、OC、OFは正確に円を3等分しているので各直線との角度は120°です。

上図では炭水化物を例にしています。直線OCの伸縮を表現するにはC点の座標を知る必要があります。

実際に摂取したエネルギー比率を表す直線OC、C点からX軸方向に伸びる直線CP’、円の中心OからY軸方向に伸びる直線OP’は直角三角形を形成していて、更に内角30°、60°、90°の特別な直角三角形なので各辺の長さが１：２：√3になるという、たしか中学校で習った覚えがある三平方の定理（ピタゴラスの定理）を適用することができます。

上図から、CのY座標＝円のTop値＋円の半径＋直線OP’　この式中の直線OP’については
OP’＝斜辺OC÷２　となります。

また、CのX座標＝円のLeft値＋（円の半径ー直線CP’）この式中の直線CP’の長さは
CP’＝斜辺OC÷２×√3　です。

斜辺の長さは、既に実際に摂取したエネルギー比率として分かってる訳ですからあらかじめ★図表摂取栄養で取得できるのでC座標、F座標はこの計算で求められます。P座標については垂直線なので直線OPの長さが直接座標に換算できますからこれは簡単です。

と言うことでこの計算方法を関数にしたものがFunction syuutenXY(引数)です。

この関数は、引数に実際に摂取した各栄養値を与えるとその栄養素の示す座標位置を返す仕事をしています。

オートシェイプの円の描画方法（Top値とLeft値）

作図用プロシージャSub zukeibyouga()、　36行目、
Set enn = ActiveSheet.Shapes.AddShape(msoShapeOval, ennleft, enntop, hankei * 2, hankei * 2)

この一文で円を描画しています。

<strong>リファレンス　<span style="color: #ff6600;">AddShape(Type, Left, Top, Width, Height)</span></strong>

1	<strong>リファレンス　<span style="color: #ff6600;">AddShape(Type, Left, Top, Width, Height)</span></strong>

AddShape(msoShapeOval, ennleft, enntop, hankei * 2, hankei * 2)
ワークシートの左からennleft、上から enntopの位置に半径hankeiの円を描画するという意味です。ennleft、enntop、hankeiはSheet2で設定されていて変更が可能です。

作図用プロシージャSub zukeibyouga()の呼び出し元の gurafukousinn()の18行目から34行目まででSheet2からデータが読み込まれて39行目でzukeibyouga()を呼び出すときに引数として渡されます。

ワークシートと描画した円の関係

上図から円の中心座標は　X＝Left＋(width÷２)、　Y=Top＋(Height÷２)となります。
この中心を起点として各PFCの３本の直線がその栄養価の値に応じた長さに変化することでグラフが表現できるようになっています。

グラフを描画する仕組みは以上のようなものですが、イメージできたでしょうか。

あとがき

PFCバランスグラフを最初に作ったのはもう20年くらい前で、会社勤めしてた時必要に迫られてエクセルで作ったのですが、その時はもっと簡単にできたような気がするのですが、エクセル自体も当時とは仕様が変化してVBAのリファレンスも変わってしまいましたから随分戸惑いもあって今回のは少し時間がかかりました。

VBAは工夫次第で自分が思うように動作するようにできる面白さがありますからやめられないです。ボケ防止には最適です。

ところで、直線の長さを変化させることでグラフの変化を更新させていますが、その時ActiveSheet.Shapes.AddShape()ではこのコードが呼び出されるたびに、新しく直線を作ってしまいます。グラフは数十、数百回と更新されますからシェイプが数百できてしまってはうまくありません。一度作ったシェイプを再利用する方法にしたかったのですが、利用できる適当な情報が見つかりませんでした。（VB、Javaなら簡単にできるのに・・・）

そこで考えたのが、作成する直線に名前を付けておいて、Shapes.AddShape()を呼び出す前にその名前のシェイプがあるときは削除する仕様にしました。18行目から32行目がその部分です。

そんな面倒なことしなくてもいいような仕様にしたかったのですが、何かいい方法があればと考えます。

レシピ作成の説明についてはまたの機会にします。今後の工夫としてはシートごとに日付を設定してレシピを１週間分としたり、サプライヤー対応の週間発注などに対応できるようにしたいと考えていますが、今はとりあえずこれで完結としておきます。

長々と読んでいただき誠にありがとうございました。