読者です 読者をやめる 読者になる 読者になる

竹林のゆとりブログ

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

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

Excelフローチャートの自動化

第一段として、一列全て→で接続されている場合に、整形できるものを作成してみました。

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

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

になります。

フローチャート

処理のフローチャートはこんな感じ

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

ソース

ソースは以下の通り

Sub Step1()

  Dim shp As Shape
  Dim dic As Object
  Dim start As String  '始まりのShape
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each shp In ActiveSheet.Shapes
      If shp.Connector Then  'AutoShapeがコネクターだったら
        With shp.ConnectorFormat
          If .BeginConnected Then _
              dic(shp.ConnectorFormat.BeginConnectedShape.Name) = .EndConnectedShape.Name  'dictionaryの要素作成
        End With
      End If
  Next
   
  For Each key In dic.keys
        varResult = Filter(dic.items, key)
        If UBound(varResult) <> -1 Then
        Else
           start = key
        End If
 Next key
  
Debug.Print "startは"; start
  
  Dim cnt As Integer
  cnt = dic.Count + 1
  Debug.Print "cnt"; cnt
  Dim Targetarray() As String
  ReDim Targetarray(cnt)
    
 Targetarray(0) = start
  key = start
  
  For i = 1 To dic.Count
  Targetarray(i) = dic.Item(key)
  key = Targetarray(i)
  Debug.Print "次は"; Targetarray(i)
  Next i
  
  For i = 0 To dic.Count
     ActiveSheet.Shapes(Targetarray(i)).Top = 60 * i + 10
     ActiveSheet.Shapes(Targetarray(i)).Left = 200
     ActiveSheet.Shapes(Targetarray(i)).Width = 60
     ActiveSheet.Shapes(Targetarray(i)).Height = 30
  Next i


End Sub

使い方

VBEに上のソースをコピペして、実行するだけです。

今後

まだまだ、改善の余地があるので、ソースも整理しつつ、どんどん機能を増やしていきます。