本サイトで公開している「VAコネクタ」は、エクセルのセルの間にカギ線(図形)を引くマクロです。これを作成する際に一番手こずったのが、「カギ線の方向」の制御でした。
VBAを使ったカギ線の追加
横方向のカギ線の場合
開始セル(rngBegin)の右端から終了セル(rngEnd)の左端までのカギ線の入力は、次のコードで実現できます。
Dim rngBegin, rngEnd '開始および終点のセル範囲
Set rngBegin = Range("C4")
Set rngEnd = Range("E8")
Dim BeginX, BeginY, EndX, EndY '始点及び終点の座標
Dim objShape '図形
'始点を設定する
With rngBegin
BeginX = .Left + .Width
BeginY = .Top + .Height / 2
End With
'終点を設定する
With rngEnd
EndX = .Left
EndY = .Top + .Height / 2
End With
'カギ線を追加する
Set objShape = ActiveSheet.Shapes.AddConnector(msoConnectorElbow, BeginX, BeginY, EndX, EndY)
縦方向のカギ線の場合
こちらも、次のコードで実現できるはずです。
Dim rngBegin, rngEnd '開始および終点のセル範囲
Set rngBegin = Range("C4")
Set rngEnd = Range("E8")
Dim BeginX, BeginY, EndX, EndY '始点及び終点の座標
Dim objShape '図形
'始点を設定する
With rngBegin
BeginX = .Left + .Width / 2
BeginY = .Top + .Height
End With
'終点を設定する
With rngEnd
EndX = .Left + .Width / 2
EndY = .Top
End With
'カギ線を追加する
Set objShape = ActiveSheet.Shapes.AddConnector(msoConnectorElbow, BeginX, BeginY, EndX, EndY)
End Sub
問題点
ところが、縦方向にカギ線を追加したいのに、横方向になってしまいます。
こうなって欲しいのに...
こうなっちゃうのです。
手動でカギ線を追加する場合は縦横の比率によってカギ線の方向が変化しますが、VBAで追加する場合は必ず横方向になってしまうようです。
対策その1(反転・回転)
次の手順で図形の反転・回転を行うことで、縦方向にカギ線を追加できます。
- 高さと幅を入れ替えた大きさのカギ線を、回転させてもウィンドウをはみ出ない位置に追加する。
- カギ線を上下反転させる。
- カギ線を90°回転させる。
- カギ線の位置を修正する。
Dim rngBegin, rngEnd '開始および終点のセル範囲
Set rngBegin = Range("C4")
Set rngEnd = Range("E8")
Dim BeginX, BeginY, EndX, EndY '始点及び終点の座標
Dim XLength, YLength '図形の幅と高さ
Dim EscapeLength '図形の退避距離(図形を回転させた際のウィンドウからのはみ出しを防止する)
Dim objShape '図形
'始点を設定する
With rngBegin
BeginX = .Left + .Width / 2
BeginY = .Top + .Height
End With
'終点を設定する
With rngEnd
EndX = .Left + .Width / 2
EndY = .Top
End With
'カギ線の高さと幅を求める
XLength = EndX - BeginX
YLength = EndY - BeginY
'図形の退避距離を求める
EscapeLength = Abs(EndX - BeginX) + Abs(EndY - BeginY)
'高さと幅を入れ替えたカギ線を追加する
'加えて退避距離分だけずらし、回転させたときにウィンドウをはみ出さないようにします。
Set objShape = ActiveSheet.Shapes.AddConnector(msoConnectorElbow, _
BeginX + EscapeLength, BeginY + EscapeLength, _
BeginX + YLength + EscapeLength, BeginY + XLength + EscapeLength)
'カギ線を上下反転させる
objShape.Flip msoFlipVertical
'カギ線を90°回転させる
objShape.IncrementRotation 90
'カギ線の位置を修正する
'加えて退避距離分のズレをもとに戻します。
objShape.IncrementLeft -YLength / 2 + XLength / 2 - EscapeLength
objShape.IncrementTop -XLength / 2 + YLength / 2 - EscapeLength
対策その2(縮小)
次の手順で図形の高さを縮小することでも縦方向のカギ線を追加できます。
- (右下方向の場合は左右を入れ替えて)縦幅を横幅の2倍の長さにした直線を追加する
- カギ線に変更する。
- 右下方向の場合は、カギ線を上下反転させ、90°回転させる。
- カギ線の高さを修正する。
Dim rngBegin, rngEnd '開始および終点のセル範囲
Set rngBegin = Range("C4")
Set rngEnd = Range("E8")
Dim BeginX, BeginY, EndX, EndY '始点及び終点の座標
Dim XLength, YLength '図形の幅と高さ
Dim objShape '図形
'始点を設定する
With rngBegin
BeginX = .Left + .Width / 2
BeginY = .Top + .Height
End With
'終点を設定する
With rngEnd
EndX = .Left + .Width / 2
EndY = .Top
End With
'カギ線の高さと幅を求める
XLength = Abs(EndX - BeginX)
YLength = Abs(EndY - BeginY)
'右下方向の場合
If BeginX <= EndX Then
'右上から左下に高さを幅の倍にした直線を追加する
'高さが上方向に修正されるように左右を入れ替えて引きます
Set objShape = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, EndX, BeginY, BeginX, EndY + 2 * XLength)
'左下方向の場合
Else
'右上から左下に高さを幅の倍にした直線を追加する
Set objShape = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, BeginX, BeginY, EndX, BeginY + 2 * XLength)
End If
'カギ線に変更する
objShape.ConnectorFormat.Type = msoConnectorElbow
'右下方向の場合
If BeginX <= EndX Then
'上下を反転させる
objShape.Flip msoFlipVertical
'180°回転させる
objShape.IncrementRotation 180
End If
'高さを修正する
objShape.Width = YLength
関連記事
本記事の手法を用いた「VAコネクタ」(対策その1を使用したもの)は、こちらで公開しています。
コメント
「対策」を「行高さを一時的に変更する」から「図形を反転・回転させる」に変更しました。