tracのワークフローをExcelの図で作った状態遷移図から作ってみる

Tracのワークフローを作るのは難しいということをよく聞く。本当に難しいのかってことを少し考えてみる。WorkflowEditorPluginもあるので、私は、ちょっとしたことに気を付けてやれば、難しいというよりめんどうなだけだと思っています。

私は次の二点に気を付けて、

1. 一つのステータスに移動するアクションを（leaveを除いて）一つにする
2. ちょっとした遠回りで済む、必要のない遷移は削除して簡単にしておく。(例：accept->acceptはaccept->assign->accept)

次の手順でワークフローを作っていきます。
1. Visioで状態遷移図を作る（ステータスを配置し曲線のコネクタでつなぐ）
2. アクションを決める
2. 図を印刷してコネクタに番号をつける
3. コネクタ番号をつぶしながら、アクションのリストに遷移元を書いていく

出来上がった図はこんなかんじ。(下の図での担当変更のassignからassignが抜けてます)

ここで終わっても仕方がないので…　「図からワークローが作れればいいな」っていろいろなところで聞くんですが、実際作ってみたらどうなんだろうってことで確かめてみました。まぁ確かに図から自動で作れれば、抜けがあったりしないか確認しなくてよくなるかもしれませんね。

使い方の手順は

1. ステータスとオペレーションの一覧を更新する
設定シートを開き、status,operation,permissionを編集する（一つの表になっていますが、各列の関連はありません）

今回はfixedを追加し終わったら、コンテキストメニューの"statusとoperationの名前設定"を実行

 

2. ステータスのオートシェイプを追加
もともと次の図のようなものが用意されていたとする

コンテキストメニューの"ステータスの一覧を図に反映"を実行して、余計なものがあれば削除され、ないものはシートの左上あたりに追加されます。
※ステータスの追加は必ずこの操作で追加削除してください。

3. ステータスを線でつないでいく
（上の図に間違った接続がありますがそのままにしておきますm(_O_)m）
あとは、追加したFixedにcloseに入ってくるものをすべて接続しなおし、fixedからclosedに移動する曲線コネクタを追加し、検証が面倒になるので必要ないと思っているものを削除してしまいます。

4. アクションの一覧を作る
もとはこんなかんじ

fixを追加してoperationと権限とをcloseから移動し、closeは特別な権限のTICKET_CLOSEを設定する（fixのところの権限はTICKET_MIDIFYでなくTICKET_MODIFYです）

（fixのところの権限はTICKET_MIDIFYでなくTICKET_MODIFYです）

5. コネクタの一覧を更新する
”ワークフロー図”シートを選択して、コンテキストメニューの”コネクタの一覧を更新する”を実行すると次のように一覧が作成されます。

6. 線の一覧にアクションを割り当てる
遷移先のstatusに行くためのactionが一つの場合は、自動で設定されていますが、複数ある場合はアクションを手動でリストから選択し設定します。

7. マクロ ワークフロー設定を出力
コンテキストメニューの”設定を出力する”を実行すると”アクション”シートのA30セルに出力されます。leaveとかは手で追加すると

leave = * -> *
leave.default = 1
leave.name = 変更しない
leave.operations = leave_status
accept = assigned -> accepted
accept.name = 着手する
accept.operations = set_owner_to_self
accept.permissions = TICKET_MODIFY
reassign = new,assigned,accepted,reopened -> assigned
reassign.name = 担当者変更
reassign.operations = set_owner
reassign.permissions = TICKET_MODIFY
reopen = closed -> reopened
reopen.name = 差し戻す
reopen.operations = del_resolution
reopen.permissions = TICKET_CREATE
resolve = new,fixed -> closed
resolve.name = 解決にする
resolve.permissions = TICKET_CLOSE
fix = accepted,assigned -> fixed
fix.name = 実装済
fix.operations = set_resolution
fix.permissions = TICKET_MODIFY

試してみて、楽にはなるような気がしますが、WorkflowEditorPluginで十分なんじゃないかってところが正直な感想です。これを一般的にするには、入力のUI作ったりして重複チェックとかもちゃんとやる必要があると思いますがやる必要はないのかなぁと今はおもっています。

ThisWorkBookのマクロ

n Error GoTo 0
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    コンテキストメニューから削除
End Sub

Private Sub Workbook_Open()
    コンテキストメニューから削除
    Dim Newb
    Set Newb = Application.CommandBars("Cell").Controls.Add()
    With Newb
        .Caption = "未接続の直線の検索"
        .OnAction = "未接続の直線の検索"
        .BeginGroup = True
    End With
    Set Newb = Application.CommandBars("Cell").Controls.Add()
    With Newb
        .Caption = "ステータスの変更を図に反映"
        .OnAction = "statusの追加と削除"
        .BeginGroup = False
    End With
    Set Newb = Application.CommandBars("Cell").Controls.Add()
    With Newb
        .Caption = "コネクタの一覧を更新する"
        .OnAction = "直線の一覧をつくる"
        .BeginGroup = False
    End With
    Set Newb = Application.CommandBars("Cell").Controls.Add()
    With Newb
        .Caption = "設定を出力する"
        .OnAction = "設定を出力する"
        .BeginGroup = False
    End With
    Set Newb = Application.CommandBars("Cell").Controls.Add()
    With Newb
        .Caption = "statusとoperationの名前設定"
        .OnAction = "statusとoperationの名前設定"
        .BeginGroup = False
    End With
'
End Sub

Module1のマクロ

'Copyright (c) 2011 Yuji OKAZAKI. All rights reserved.
'
'Redistribution and use in source and binary forms, with or without modification, are permitted provided
'that the following conditions are met:
'
' 1. Redistributions of source code must retain the above copyright notice, this list of conditions and
'   the following disclaimer.
' 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions
'   and the following disclaimer in the documentation and/or other materials provided with the
'   distribution.
'
'THIS SOFTWARE IS PROVIDED BY THE FREEBSD PROJECT ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
'INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
'A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FREEBSD PROJECT OR CONTRIBUTORS BE LIABLE
'FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
'NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
'OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
'STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
'THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Sub statusの追加と削除()
    Dim s As Worksheet
    Dim sFig As Worksheet
    Dim c As Collection
    Dim oval As Shape
    Set s = Sheet2
    Set sFig = Sheet1
    s.Activate
    If s.Cells(1, 1).Value <> "status" Then
        If s.Cells(1, 1).Value <> "ステータス" Then
            MsgBox "AIセルがstatusではありません"
            Exit Sub
        End If
    End If
    Dim row As Integer
    row = 2
    Set c = New Collection
   
    Do ' status(円)を追加します
        Dim status As String
        status = s.Cells(row, 1)
        If status = "" Then Exit Do
        On Error Resume Next
        Debug.Print status
        Set oval = Nothing
        Set oval = sFig.Shapes.Item(status)
        On Error GoTo 0
        If oval Is Nothing Then ' 存在していなければ追加
            Set oval = sFig.Shapes.AddShape(msoShapeOval, 200, 0, 100, 100)
            oval.TextEffect.Text = status
            oval.name = status
        End If
        c.Add oval, status
        row = row + 1
    Loop
   
    Call statusとoperationの名前設定
   
    For Each sh In sFig.Shapes ' 存在していないstatus(円)を削除
        If sh.AutoShapeType = msoShapeOval Then '楕円
            Dim i As Shape
            Set i = Nothing
            On Error Resume Next
            Set i = c.Item(sh.name)
            On Error GoTo 0
            If i Is Nothing Then '削除する
                MsgBox "statusリストに存在しないステータス(" & sh.name & ")を削除します。"
                sh.Delete
            End If
        End If
    Next
    sFig.Activate
End Sub

Function 未接続の直線を検索0() As Boolean
    Dim s As Worksheet
    Set s = Sheet1
    未接続の直線を検索0 = False
    s.Activate
    For Each sh In s.Shapes
        If sh.AutoShapeType = msoShapeMixed Then '直線 <-だけではないみたい
            Dim i As Shape
            Set i = sh
            If i.Connector Then 'コネクター
                Debug.Print sh.name
                If sh.ConnectorFormat.BeginConnected = False Or sh.ConnectorFormat.EndConnected = False Then
                    Debug.Print "未接続"
                    i.Select
                    MsgBox "未接続のコネクタがあります"
                    Exit Function
                Else
                    Debug.Print "元シェイプ：" & sh.ConnectorFormat.BeginConnectedShape.name
                    Debug.Print "先シェイプ：" & sh.ConnectorFormat.EndConnectedShape.name
                End If
            End If
        End If
    Next
    未接続の直線を検索0 = True
End Function

Sub 未接続の直線の検索()
    If 未接続の直線を検索0() Then
        MsgBox "未接続のコネクタはありませんでした"
    End If
End Sub

Sub 直線の一覧をつくる()
    If Not 未接続の直線を検索0() Then
        Exit Sub
    End If
    Dim s As Worksheet
    Dim row As Integer
    Set s = Sheet1
    row = 2
    For Each sh In s.Shapes
        If sh.AutoShapeType = msoShapeMixed Then '直線?
            If sh.Connector Then '
                If sh.ConnectorFormat.BeginConnected And sh.ConnectorFormat.EndConnected Then
                    Dim status As String, default As String, list As String
                    s.Cells(row, 1).Value = sh.name
                    s.Cells(row, 2).Value = sh.ConnectorFormat.BeginConnectedShape.name
                    status = sh.ConnectorFormat.EndConnectedShape.name
                    s.Cells(row, 3).Value = status
                    'ここでアクションをみて
                    特定のステータスに遷移するアクションの情報を取得する status, default, list
                    コネクタにアクションを設定する s.Cells(row, 4), default, list
                    row = row + 1
                End If
            End If
        End If
    Next
    Do
        If s.Cells(row, 1).Value = "" Then
            Exit Do
        End If
        s.Cells(row, 1).Value = ""
        s.Cells(row, 2).Value = ""
        s.Cells(row, 3).Value = ""
        s.Cells(row, 4).Validation.Delete
        s.Cells(row, 4).Value = ""
        row = row + 1
    Loop
End Sub

Private Sub 特定のステータスに遷移するアクションの情報を取得する(status As String, ByRef default As String, ByRef list As String)
    Dim s As Worksheet
    Set s = Sheet3
    Dim row As Integer
    Dim count As Integer
    row = 2
    count = 0
    default = ""
    list = ""
    Do
        Dim action As String
        action = s.Cells(row, 3)
        If action = "" Then
            Exit Do
        End If
        If action = status Then
            If count = 0 Then
                default = s.Cells(row, 1)
                list = s.Cells(row, 1)
            Else
                list = list + "," + s.Cells(row, 1)
            End If
            count = count + 1
        End If
        row = row + 1
    Loop
    If count > 1 Then
        default = ""
    End If
End Sub

Sub コネクタにアクションを設定する(c As Range, default As String, list As String)
    Dim s As Worksheet
    Set s = Sheet1
    On Error Resume Next
    With c.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=list
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    On Error GoTo 0
    c.Value = default
End Sub

Sub statusとoperationの名前設定()
    Dim s As Worksheet
    Dim n As name
    Set s = Sheet2
    If s.Cells(1, 1).Value <> "status" Then
        Exit Sub
    End If
    Dim row As Integer
    row = 2
    Do
        If s.Cells(row, 1).Value = "" Then Exit Do
        row = row + 1
    Loop
    '名前statusの削除
    If row >= 3 Then
        On Error Resume Next
        ActiveWorkbook.Names("status").Delete
        On Error GoTo 0
        ActiveWorkbook.Names.Add "status", s.Range(s.Cells(2, 1), s.Cells(row - 1, 1))
    End If
   
    If s.Cells(1, 2).Value <> "operation" Then
        Exit Sub
    End If
    row = 2
    Do
        If s.Cells(row, 2).Value = "" Then Exit Do
        row = row + 1
    Loop
    '名前statusの削除
    If row >= 3 Then
        On Error Resume Next
        ActiveWorkbook.Names("operation").Delete
        On Error GoTo 0
        ActiveWorkbook.Names.Add "operation", s.Range(s.Cells(2, 2), s.Cells(row - 1, 2))
    End If

    If s.Cells(1, 3).Value <> "権限" Then
        Exit Sub
    End If
    row = 2
    Do
        If s.Cells(row, 3).Value = "" Then Exit Do
        row = row + 1
    Loop
    '名前statusの削除
    If row >= 3 Then
        On Error Resume Next
        ActiveWorkbook.Names("権限").Delete
        On Error GoTo 0
        ActiveWorkbook.Names.Add "権限", s.Range(s.Cells(2, 3), s.Cells(row - 1, 3))
    End If
End Sub

Sub 設定を出力する()
    Dim s As Worksheet
    Set s = Sheet3
    Dim row As Integer
    Dim count As Integer
    row = 2
    s.Cells(30, 1).Value = ""
    If アクション未設定の有無() Then
        MsgBox "アクションが未設定のコネクタがあります"
        Exit Sub
    End If
    Do
        Dim action As String
        Dim name As String
        Dim next_status As String
        Dim permission As String
        Dim operation As String
        action = s.Cells(row, 1)
        If action = "" Then
            Exit Do
        End If
        name = s.Cells(row, 2)
        next_status = s.Cells(row, 3)
        permission = s.Cells(row, 4)
        operation = s.Cells(row, 5)
        s.Cells(30, 1).Value = s.Cells(30, 1).Value + action & " = " & 元ステータス(action) & " -> " & next_status + vbCrLf
        s.Cells(30, 1).Value = s.Cells(30, 1).Value + action & ".name = " & name + vbCrLf
        If operation <> "" Then
            s.Cells(30, 1).Value = s.Cells(30, 1).Value + action & ".operations = " & operation + vbCrLf
        End If
        s.Cells(30, 1).Value = s.Cells(30, 1).Value + action & ".permissions = " & permission + vbCrLf
        row = row + 1
    Loop
    s.Activate
End Sub

Private Function アクション未設定の有無() As Boolean
    Dim s As Worksheet
    Dim row As Integer
    Set s = Sheet1
    row = 2
    アクション未設定の有無 = False
    Do
        If s.Cells(row, 1).Value = "" Then
            Exit Do
        End If
        If s.Cells(row, 4).Value = "" Then
            アクション未設定の有無 = True
        End If
        row = row + 1
    Loop
End Function

Private Function 元ステータス(action As String) As String
    Dim s As Worksheet
    Dim row As Integer
    Set s = Sheet1
    row = 2
    元ステータス = ""
    Do
        If s.Cells(row, 4).Value = "" Then
            Exit Do
        End If
        If s.Cells(row, 4).Value = action Then
            If 元ステータス <> "" Then
                元ステータス = 元ステータス + ","
            End If
            元ステータス = 元ステータス + s.Cells(row, 2).Value
        End If
        row = row + 1
    Loop
End Function

「TracWorkFlow.zip」をダウンロード 

Excel2010でしか確認してません。変なものを作りこんだ気はありませんが、ダウンロードしたファイルを使用したことによって、何が起こっても責任持ちません。なんかVBAいじくるの疲れてきたんでここいらへんでいったん終わらせます。

（アクションシートのfixのところの権限はTICKET_MIDIFYでなくTICKET_MODIFYに修正しないと動作しません。resolveのところのTICKET_CLOSE権限を作らない場合はTICKET_MODIFYに変更してください）