【超初心者】一から始めるアプリ開発

フローチャート作りもいよいよ大詰めとなりました。

完成とするには、3つの課題が残っております。
・図形揃えで線が反応する
・複数図形一括つなぎ
・線種を切り替える

今回は、図形揃えで線を反応させなくする処理を作ります。

おさらいになりますが、
図形の中央揃えをつくりました。
全ての図形と選択図形を中央揃えする、二つのプロシージャを作ったのですが、
標準モジュールが増えたので、どこに組んだか分からなくなるので、
まず、モジュールの名前を変更します。

図形中央揃えは、全図形と選択図形の二つなんですが、
選択図形の場合、線を選ばなければ問題ないので、
全図形の方を修正していきます。

修正する部分を確認する為にプロシージャを見てみます。
標準モジュール（ShapeCentering）

Option Explicit

Sub PositionCheck()

    Dim sh As Shape    '図形取得'
    Dim cell As Range  '図形下セル取得'
    
    Dim posLeft As Double    '図形の左位置'
    Dim posTop As Double     '図形の縦位置'
    Dim leftBorder As Double '横境界線'
    Dim topBorder As Double  '縦境界線'
    
    Dim addLeft As Integer   '横の補正値'
    Dim addTop As Integer    '縦の補正値'
     
    For Each sh In ActiveSheet.Shapes
      
        Set cell = ActiveSheet.Shapes(sh.Name).TopLeftCell
        addLeft = 0
        addTop = 0
            
        '境界線を計算'
        leftBorder = cell.Width - (sh.Width / 2)
        topBorder = cell.Height - (sh.Height / 2)
    
        '図形の位置を計算'
        posLeft = sh.Left - cell.Left
        posTop = sh.Top - cell.Top
    
        '境界を越えてるか判断'
        If posLeft > leftBorder Then
            addLeft = cell.Width
            
        End If
        
        If posTop > topBorder Then
            addTop = cell.Height
            
        End If
        
        '図形の移動'
        With ActiveSheet.Shapes(sh.Name)
            .Top = cell.Top + (cell.Height - .Height) / 2 + addTop
            .Left = cell.Left + (cell.Width - .Width) / 2 + addLeft

        End With

    Next
    
End Sub

ループで図形を拾って、中央に移動させるようにしています。
この図形を拾う時に線を識別できると修正ができそうです。

まず線の名前を調べてみます。

直線ならStraightArrow、
カギ線ならElbow、
となっています。

名前の後ろには、通しナンバーが付属されてます。
名前を特定して条件文に当てはめるのは無理そうです。

そこで、図形線の名前には、○○Connectorと付けられてるので、
このConnectorを利用します。

文字列から特定の文字列を検索するには、Like演算子を使う事で判断できます。
PositionCheckプロシージャ

    '線に含まれる文字'
    Const lineName As String = "*Connector*"
    
    
    For Each sh In ActiveSheet.Shapes
    
        '名前にConnectorが付いてる場合'
        If sh.Name Like lineName Then

        End If

拾った図形の名前からConnectorの文字列があればとなります。

これで図形線を判断できるようになるので、
図形移動の処理を飛ばせばいいのですが、ループを飛ばす方法は…

C#には、Continueコマンドがあって、
ループを飛ばす事ができるのですが、ExcelVBAには無いようなので自作します。

代用は、GoToで行います。

ちなみに、
ループを強制終了させるには、Exit Forとすればいいようです。
標準モジュール（ShapeCentering）

Sub PositionCheck()

    Dim sh As Shape    '図形取得'
    Dim cell As Range  '図形下セル取得'
    
    Dim posLeft As Double    '図形の左位置'
    Dim posTop As Double     '図形の縦位置'
    Dim leftBorder As Double '横境界線'
    Dim topBorder As Double  '縦境界線'
    
    Dim addLeft As Integer   '横の補正値'
    Dim addTop As Integer    '縦の補正値'
    
    '線に含まれる文字'
    Const lineName As String = "*Connector*"
    
    For Each sh In ActiveSheet.Shapes
    
        '名前にConnectorが付いてる場合は飛ばす'
        If sh.Name Like lineName Then
            GoTo Continue
        
        End If
    
        Set cell = ActiveSheet.Shapes(sh.Name).TopLeftCell
        addLeft = 0
        addTop = 0
            
        '境界線を計算'
        leftBorder = cell.Width - (sh.Width / 2)
        topBorder = cell.Height - (sh.Height / 2)
    
        '図形の位置を計算'
        posLeft = sh.Left - cell.Left
        posTop = sh.Top - cell.Top
    
        '境界を越えてるか判断'
        If posLeft > leftBorder Then
            addLeft = cell.Width
            
        End If
        
        If posTop > topBorder Then
            addTop = cell.Height
            
        End If
        
        '図形の移動'
        With ActiveSheet.Shapes(sh.Name)
            .Top = cell.Top + (cell.Height - .Height) / 2 + addTop
            .Left = cell.Left + (cell.Width - .Width) / 2 + addLeft

        End With
    
Continue:
    Next
    
End Sub

Connector文字列が含まれてる場合は、Continue:まで飛ぶように
条件文で設定すれば、1周りのループを飛ばす事ができます。

修正ができたので、テストPLAYでっす。

適当に図形をズラして揃えボタンをPush！

うまく機能しています。

線が中央揃えに反応すると結合が解かれるので、
図形を移動させて線がついてくるかテストしてみます。

無事に結合されたままになっています。ヽ(´▽｀)/～♪

線を気にせず図形移動ができるようになったので、
フロー作りが楽になります。

一つ目の修正が無事終わりました。
残すは二つ…

この二つが悩み処なんですね～
アイディアがまとまったら記事にしようと思います。
それまで(TωT)/~~~　BYE　BYE