少し減量に成功したケロです。
全然、記事とは関係ない事から書き始めましたが、
ウォーキング1hr~1.5hrほどするとPCを触る時間が減ります。
なのでブログも更新が進まないって事が書きたかったですが…
個人的な話なんでこれくらいにして。
フローの修正が残っていたので、まとめてみようと思います。
今回は、複数の図形に一括で直線を繋げる処理を作ってみます。
カギ線の場合、結合点を指定する必要があるので、
直線のみの対応になります。
ここで考えておく必要があるのが、
・全図形なのか
・選択した図形なのか
の二点です。
フローなら図形が当然増えていきます。
全図形にすると数が多い事や、後から追加した図形の接続を考えると、
選択した図形の一括接続がいいと思います。
まず、以前に作った図形接続のプロシージャを見てみます。
標準モジュール4に作っていたので、リネームしてLineConnectに変更します。

オブジェクト名を変更するとリネームする事ができます。
LineConnectモジュールを開いて、接続プロシージャを開きます。
標準モジュール(LineConnect)
Option Explicit
Sub Connection()
Dim arrow As Shape '矢印線取得'
Dim selectSh(2) As Shape '選択中の図形取得'
Dim sh As Shape '図形検索変数'
Dim i As Long '配列カウント変数'
i = 0
'選択中の図形を検索して取得'
For Each sh In Selection.ShapeRange
Set selectSh(i) = sh
i = i + 1
Next
'仮線を作成'
Set arrow = ActiveSheet.Shapes.AddConnector _
(msoConnectorStraight, 1, 1, 1, 1)
'仮線を図形に繋ぐ'
With arrow
.ConnectorFormat.BeginConnect selectSh(0), 1
.ConnectorFormat.EndConnect selectSh(1), 1
.RerouteConnections
'線の書式設定'
With .Line
.EndArrowheadStyle = msoArrowheadTriangle
.Visible = msoTrue
.Weight = 1.75
End With
End With
End Sub
図形二つを選択状態にして、接続しています。
カギ線の所でも書いたのですが、無選択状態だとエラーが発生します。
また選択した図形が一つの場合もエラーが出るので、
先に修正していきます。
標準モジュール(LineConnect)
Option Explicit
Sub Connection()
Dim arrow As Shape '矢印線取得'
Dim selectSh(2) As Shape '選択中の図形取得'
Dim sh As Shape '図形検索変数'
Dim i As Long '配列カウント変数'
'無選択エラー回避'
On Error GoTo NotSelect
'選択数が二つ以上か判断'
If Selection.ShapeRange.Count = 1 Then
GoTo SelectOne
End If
i = 0
'選択中の図形を検索して取得'
For Each sh In Selection.ShapeRange
Set selectSh(i) = sh
i = i + 1
Next
'仮線を作成'
Set arrow = ActiveSheet.Shapes.AddConnector _
(msoConnectorStraight, 1, 1, 1, 1)
'仮線を図形に繋ぐ'
With arrow
.ConnectorFormat.BeginConnect selectSh(0), 1
.ConnectorFormat.EndConnect selectSh(1), 1
.RerouteConnections
'線の書式設定'
With .Line
.EndArrowheadStyle = msoArrowheadTriangle
.Visible = msoTrue
.Weight = 1.75
End With
End With
Exit Sub
SelectOne:
MsgBox "二つ以上選択してね!"
Exit Sub
NotSelect:
MsgBox "選択できてないよ!"
End Sub
これで無選択・一つ選択の場合、エラー回避ができます。
実際にテストすると、

こんな感じで処理されます。
エラー回避ができるようになったので、
接続処理の部分を修正して行きます。
ここで問題になるのが図形の数が変動するって事です。
通常配列では、宣言時に要素数を設定する必要があるのですが、
変動する場合は、対応しにくいんですよねヽ(´~`;)ウーン
そこで図形の数に対応した配列を作ってみます。
動的配列といいますが、
ExcelVBAでは、一度配列宣言した変数を再宣言する事ができます。
設定方法は、
Dim a() As Long
ReDim a(要素数)
配列変数にする場合、変数の後ろに()を付けます。
本来は、()内に要素数を指定するのですが、動的にする場合は、
配列の宣言だけでOKです。
配列の宣言ができた所で、使う前にReDimを使って再宣言すれば
動的な使い方ができます。
実際にテストしてみます。
Option Explicit
Sub testarray()
Dim num() As Long
ReDim num(Range("A4"))
MsgBox UBound(num)
End Sub
セルA4に再宣言する要素数を入力しておきます。
UBoundは、配列が持つ要素数を出力してくれるコマンドです。
これでテストすると

バッチリ必要な要素数に設定できております。ヽ(´▽`)/~♪
使い方が分かった所で修正部分に組み込んでいきます。
Connectionプロシージャ
Sub Connection()
Dim arrow As Shape '矢印線取得'
Dim selectSh() As Shape '選択中の図形取得'
Dim sh As Shape '図形検索変数'
Dim i As Long '配列カウント変数'
'無選択エラー回避'
On Error GoTo NotSelect
'選択数が二つ以上か判断'
If Selection.ShapeRange.Count = 1 Then
GoTo SelectOne
End If
ReDim selectSh(1 To Selection.ShapeRange.Count)
i = 1
'選択中の図形を検索して取得'
For Each sh In Selection.ShapeRange
Set selectSh(i) = sh
i = i + 1
Next
エラーが回避できたら図形取得のループが始まるので、
その前に再宣言します。
再宣言では、(1 To Selection.ShapeRange.Count)と設定しましたが、
通常の配列は、0から始まります。
図形0個はおかしいので、1からスタートさせる必要があります。
なので、再宣言で1から始めろと命令しています。1 Toがその部分になります。
要素数は、選択図形の数なので、Selection.ShapeRange.Countで数を設定します。
これで1~選択数の配列が用意できます。
今回は、Shape型を使ってますが、Variant型で変数宣言しておくと
変数の型を自動的に設定してくれるので、型が流動的になります。
複数の型を使用する時に重宝するので覚えておくといいかと思います。
これで、図形を動的に取得する事ができるので、
図形接続を修正していきます。
Connectionプロシージャ
For i = 1 To Selection.ShapeRange.Count
If i = 1 Then
GoTo Continue
End If
'仮線を作成'
Set arrow = ActiveSheet.Shapes.AddConnector _
(msoConnectorStraight, 1, 1, 1, 1)
'仮線を図形に繋ぐ'
With arrow
.ConnectorFormat.BeginConnect selectSh(i - 1), 1
.ConnectorFormat.EndConnect selectSh(i), 1
.RerouteConnections
'線の書式設定'
With .Line
.EndArrowheadStyle = msoArrowheadTriangle
.Visible = msoTrue
.Weight = 1.75
End With
End With
Continue:
Next
図形の数だけループを回して接続するのですが、
接続は、図形の数より1回分少ないので、
ループの頭か終わりを飛ばす必要があります。
今回は、1回目を飛ばして、2回目のループから接続処理をさせてみました。
これで一括接続ができると思うので、テストしてみます。

上手く機能してくれてます。
個数を変えて接続してみます。

良い感じです。(^ё^) ♪♪
これで一括接続が使えるので、図形だけ作っておいて、
まとめて接続が可能になりました。
最後に完成版を載せておきます。
標準モジュール(LineConnect)
Option Explicit
Sub Connection()
Dim arrow As Shape '矢印線取得'
Dim selectSh() As Shape '選択中の図形取得'
Dim sh As Shape '図形検索変数'
Dim i As Long '配列カウント変数'
'無選択エラー回避'
On Error GoTo NotSelect
'選択数が二つ以上か判断'
If Selection.ShapeRange.Count = 1 Then
GoTo SelectOne
End If
ReDim selectSh(1 To Selection.ShapeRange.Count)
i = 1
'選択中の図形を検索して取得'
For Each sh In Selection.ShapeRange
Set selectSh(i) = sh
i = i + 1
Next
For i = 1 To Selection.ShapeRange.Count
If i = 1 Then
GoTo Continue
End If
'仮線を作成'
Set arrow = ActiveSheet.Shapes.AddConnector _
(msoConnectorStraight, 1, 1, 1, 1)
'仮線を図形に繋ぐ'
With arrow
.ConnectorFormat.BeginConnect selectSh(i - 1), 1
.ConnectorFormat.EndConnect selectSh(i), 1
.RerouteConnections
'線の書式設定'
With .Line
.EndArrowheadStyle = msoArrowheadTriangle
.Visible = msoTrue
.Weight = 1.75
End With
End With
Continue:
Next
Exit Sub
SelectOne:
MsgBox "二つ以上選択してね!"
Exit Sub
NotSelect:
MsgBox "選択できてないよ!"
End Sub
この記事へのトラックバック
この記事へのコメント