【ExcelVBA】指定セルの中央に図形を作成する

ExcelVBAを触り出すと奥が深いと言うか…
分からない事だらけです。(T^T) ヒック

毎日、調べる作るの繰り返しでして、
Unityに戻れるのは、いつになる事やら…

そろそろ戻りたいってのもあるのですが、
折角、触れるようになってきたExcelVBAなんで、
最後に、今後使っていける何かを作りたいなと思いました。

自称プログラマーなんで、やはり”フローチャート”
必須ですよね。

プログラムのフロー起こしって、結構面倒だったりします。
Excelで綺麗に仕上げようと思うと手間も掛かります。

なので、マクロで少しでも楽に作成できる物を作ってみます。

フローチャートのマクロで必要な機能とすれば、
・図形作成
・図形を綺麗に並べる
・図形移動
・図形をラインで繋げる

こんな感じになりそうです。

今回は、図形作成をマクロで組む事にします。

図形と言っても種類があるので、
各種類を綺麗に配置できるように組んでみたいと思います。

今回、図形は5種類を用意します。
作図①.jpg
・シェイプ69番 端子
・シェイプ61番 処理
・シェイプ63番 分岐
・シェイプ67番 書類
・シェイプ73番 結合

フローの内容によって図形が変わるので、
今回は、プログラムで良く使う5つをピックアップしてみました。

これを作図して、綺麗に並べようと思います。
まず作図なんですが、
ActiveSheet.Shapes.AddShape(図形タイプ,左位置,縦位置,横幅,縦幅)
こんな感じで作図する事ができるようです。

簡単に作図してみようと思います。
標準モジュール

Sub 図形作成()

With ActiveSheet.Shapes.AddShape(69, 100, 100, 100, 100)

'図形の条件を設定する'

End With

End Sub

69番のシェイプを左から100、上から100の位置に
100✕100の大きさで追加しなさいと言う命令になります。

Withの中に図形の色や文字など、条件を設定する事ができます。
こんな感じで簡単に図形が作れるので、綺麗に並べる部分を考えてみます。

並べる場合、セルを使う事になるのですが、
グリッド線に合わせるかセルの中心に合わせるかで座標取得が変わってくるかと思います。

今回は、セルの中央に図形を張り付ける事で並べてみようと思います。

まず、図形の大きさを揃えて、セルサイズを調整します。
作図②.jpg
図形が見やすい大きさって事で、100✕50に設定しました。
フローなんで、隣の図形が重なると線が引けなくなるので、
セルの大きさは、縦の間隔と横の間隔を調整して、24✕70に調整しました。

セルの中心に図形を張り付けたら綺麗に並ぶようになります。

まずフロー開始と終了図形の”端子”を加工します。
標準モジュール

Sub ShapeMake()

Dim createSh As shape '図形取得用'

Set createSh = ActiveSheet.Shapes.AddShape(69, 100, 100, 100, 50)

With createSh

.Fill.ForeColor.RGB = RGB(32, 56, 100)
.Line.Visible = msoFalse

With .TextFrame.Characters
.Text = "フロー"
.Font.Size = 9
.Font.Color = RGB(255, 255, 255)

End With


With .TextFrame
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter

End With

End With

End Sub

Withの中身を説明すると、
.Fill.ForeColorは、図形の色になります。
RGBを設定してやれば、お好みの色に染める事ができます。

.Line.Visibleは、図形には縁取り線が入っているので、
消す設定にしました。msoFalseとすれば縁取りが無くなります。

続いて、図形内の文字の設定をします。
TextFrame.Charactersとする事で図形内のテキストを編集する事ができます。
入力文字、サイズ、色の指定をしました。

最後に文字の中揃えを設定します。
縦・横の中心に文字を揃える設定になります。

これで端子の設定ができたのですが、残り4つ… しょうじき面倒です。
コーディングに設定数値を入力するだけで目が回りそうです。(*0*;)

そこで、別シートに図形の条件をデータ化して、
図形に合わせて、処理できるように変更します。

まず、"図形データ"と言うシートを作ります。
作図③.jpg
ざっくりと作って申し訳ないです。

図形に表示するラベルから条件を書き出しておきます。

このデータを元に図形を作図させます。
シート上の表からデータを読み込むには、関数でお馴染みVLookupを使います。

VLookupを知らない方に軽く説明すると、
表の範囲から指定したデータを元に、数値や文字を検索する関数です。

スクショの表なら、ラベルの部分を指定する事で、
列からデータを読み込む事ができます。
WorksheetFunction.VLookup(指定値, データ範囲, 列, False)

例えば、"フロー"と指定して、タイプを検索する場合、
WorksheetFunction.VLookup("フロー", Worksheets("図形データ").Range("A4:J8"), 2, False)
検索範囲を指定する時に、シートを設定する必要があるので、
シート名.範囲と設定します。

列の順番は、ラベルが1、タイプが2、色Rが3,と横に見て行きます。
1列目を条件に、何列目のデータが欲しいと設定すると自動的に探してくれます。
タイプなら2列目なので、2と設定します。

これを作図プロシージャに組み込みます。
標準モジュール

Sub ShapeMake(label As String)

Dim createSh As shape '図形取得用'

'図形データ取得変数'
Dim shData(7) As Integer 'データ取得配列'
Dim arrayNum As Integer '配列番号'
Dim i As Integer 'ループ変数'

'図形データを取得する'
For i = 2 To 8

shData(arrayNum) = WorksheetFunction.VLookup _
(label, Worksheets("図形データ").Range("A4:J8"), i, False)

arrayNum = arrayNum + 1

Next

'図形作成'
Set createSh = ActiveSheet.Shapes _
.AddShape(shData(0), posLeft, posTop, shData(5), shData(6))

'図形の設定'
With createSh

.Fill.ForeColor.RGB = RGB(shData(1), shData(2), shData(3))
.Line.Visible = msoFalse

With .TextFrame.Characters
.Text = label
.Font.Size = 9
.Font.Color = RGB(shData(4), shData(4), shData(4))

End With


With .TextFrame
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter

End With

End With

End Sub

ラベルは引数で設定しました。
各図形ボタンを用意して、ボタン側でラベルを設定します。

データの取得は、ループを回して配列変数に取り込みます。
ループのカウントiは、検索範囲の2~8までの列数をカウントしています。

そのまま配列shData(i)とすると、shData(2)~(8)となってしまいます。
iを代入するとおかしくなるので、arrayNumを設定して、shData(0)~(6)と修正しています。

作図のプロシージャが組めたので、ボタンを用意します。
ボタンは、ユーザーフォームで作ります。

5つボタンを用意して、それぞれにコーディングします。
作図⑤.jpg
ボタンモジュールにコーディングする際は、ユーザーフォーム上のボタンを右クリック、
メニューからコードを表示すると書き込む事が出来ます。
ボタンモジュール

Private Sub CommandButton1_Click()

'図形のラベル'
Const label As String = "フロー"

Call ShapeMake(label)

End Sub

フローのボタンモジュールの設定です。
先で作った、ShapeMakeプロシージャに引数を設定してコールします。
作図⑥.jpg
各、ボタンそれぞれのラベルネームを設定すれば対応できます。

これで作図までできるようになったので、
セルの中心に張り付けるように設定します。

まず、セルの中心と言っても、どのセルかってのが分からないと
設定できないので、選択したセルの中心に張り付けるように設定します。

選択中のセルは、ActiveCellで取得できるので、
中心を計算する必要があります。

セル24✕70に設定しましたが、
マクロから取得する幅と高さが分からないと計算もできないので、
調べてみます。

MsgBox "幅:" & ActiveCell.Width & vbCrLf & _
"高さ:" & ActiveCell.Height

どこでもいいので、上のコードを仕込んで、
セルのサイズを呼び出してみます。
作図⑦.jpg
セルサイズが分かりました。

計算としては、
作図⑧.jpg
セルの横幅-図形幅=図形両サイドの隙間なので、
それを2で割れば、片方の隙間になります。

(147.5-100)/2で、セルの左端からの位置が計算できます。

高さも同じ考えで、(70-50)/2で、上からの位置が計算できます。

この計算式を図形作成に組み込んでやります。
標準モジュール

Sub ShapeMake(label As String)

Dim createSh As shape '図形取得用'

'図形データ取得変数'
Dim shData(7) As Integer 'データ配列'
Dim arrayNum As Integer '配列番号'
Dim i As Integer 'ループ変数'
Dim posLeft As Double '選択セル内の左側の位置'
Dim posTop As Double '選択セル内の上側の位置'


'図形データを取得する'
For i = 2 To 8

shData(arrayNum) = WorksheetFunction.VLookup _
(label, Worksheets("図形データ").Range("A4:J8"), i, False)

arrayNum = arrayNum + 1

Next


'選択セルの中央座標を計算'
With ActiveCell
posLeft = .Left + (.Width - shData(5)) / 2
posTop = .Top + (.Height - shData(6)) / 2

End With

'図形作成'
Set createSh = ActiveSheet.Shapes _
.AddShape(shData(0), posLeft, posTop, shData(5), shData(6))

'図形の設定'
With createSh

.Fill.ForeColor.RGB = RGB(shData(1), shData(2), shData(3))
.Line.Visible = msoFalse

With .TextFrame.Characters
.Text = label
.Font.Size = 9
.Font.Color = RGB(shData(4), shData(4), shData(4))

End With


With .TextFrame
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter

End With

End With

End Sub

これで、どの図形も選択したセルの中央に張り付ける事ができそうです。

早速テストでっす。
作図⑨.jpg
A1セルを選択して、ボタンをPush!

無事、選択セルの中央に図形を張り込んでくれました。ヽ(´▽`)/~♪

フロー作りの第一弾として、作図ができました。
ただ、図形をドラッグして動かすとズレてしまって綺麗に並ばないんですよ( ノД`)シクシク…

次回は、図形移動を作ってみようと思います。

作図については以上になります。
それでは、この辺で(^.^/)))~~~bye!!


この記事へのコメント