竹林のゆとりブログ

山奥で生活し、日々の思いをつらつらと書くブログ。 IT、数学、アニメなど。

Excelでフローチャートを自動整形する②

昨日の結果を拡張するものを作ったので、公開します。

今回は、

f:id:fatal-t-h-f-flydream-bamboo:20160203193328p:plain

f:id:fatal-t-h-f-flydream-bamboo:20160202233408p:plain

にします。

要は、フローチャートをつなげるのは面倒なので、 →が□のなかにあれば、それを自動で判断するマクロです。

functionを使ってみたかったので、今回はsub1つに閉じていません。2つに分けています。

ソース

Sub connect()

For Each shp In ActiveSheet.Shapes
      If shp.Connector Then 'AutoShapeがコネクターだったら
         With shp

          If .HorizontalFlip = msoTrue Then
                 If .VerticalFlip = msoTrue Then
                 start_x = .Left + .Width
                 start_y = .Top + .Height
                 end_x = .Left
                 end_y = .Height
                 
                  Else
                  
                 start_x = .Left + .Width
                 start_y = .Top
                 end_x = .Left
                 end_y = .Top + .Height
                  
                 End If
          Else
                 If .VerticalFlip = msoTrue Then

                 start_x = .Left
                 start_y = .Top + .Height
                 end_x = .Left + .Width
                 end_y = .Top
                  Else
  
                  
                 start_x = .Left
                 start_y = .Top
                 end_x = .Left + .Width
                 end_y = .Top + .Height
                  End If
           End If
         End With
         start_conn = conn_find(start_x, start_y)
         end_conn = conn_find(end_x, end_y)
         
    
        If shp.ConnectorFormat.BeginConnected Then
        
        Else
              shp.ConnectorFormat.BeginConnect ActiveSheet.Shapes(start_conn), 3
        End If
        
        If shp.ConnectorFormat.EndConnected Then
        
        Else
              shp.ConnectorFormat.EndConnect ActiveSheet.Shapes(end_conn), 1
        End If
        
         
         Debug.Print start_conn
     End If
     
Next shp
End Sub


Public Function conn_find(ByVal x As Integer, ByVal y As Integer) As String
  '見つからない場合はnoを返却
conn_find = "no"

For Each shp In ActiveSheet.Shapes
      If shp.Connector Then 
      Else
           If shp.Top <= y And y <= shp.Top + shp.Height Then
              If shp.Left <= x And x <= shp.Left + shp.Width Then
                conn_find = shp.Name
              End If
            End If
       End If
  Next
   
   Debug.Print conn_find
   
End Function

使い方

ソースを貼り付けて、connect()を実行するだけです。

注) これがうまくいく条件は、→の始点が全て□の中にある時です。
今回やっつけで作ったために、→の始点と終点がどれか1つでも□の外にある場合、実行時エラーとなります。

おわり

いろいろ便利な世界にしたいですね。