👏🏼 👼🏻 🤒 Excel全能とRedmine：Excelでタスクを直接生成する方法 🌲 😧 👃🏼

IT設計組織から遠く離れて、Excelは処理ツールとしてよく使用されます。

プロジェクト部門にタスクを渡す非常に特定のプロジェクトのExcelでの監視を設定するために、非常に短い時間でタスクがありました。 TKの監視に関しては、多かれ少なかれ定義されており、すべての機能はExcel自体のVBAツールを使用して実装されました。

タスクの発行では、すべてがそれほど明確ではありませんでした。私は肘掛け椅子をきしむ音を立てて、Excelから直接Redmineにタスクを送信し、ハイパーリンクとタスク番号を取得することにしました。

この記事は、プログラミングの初心者向けに、即席のツールで日常業務を自動化する設計エンジニアによって書かれました。コメントがあれば嬉しいです！

これはなぜですか？

設計業界のExcelは、図面用のAutoCADのようなコラボレーション組織間ですべての種類のドキュメントリストと仕様を交換するとき、事実上同じ標準であることがありました。

これは私たちの組織にしかないと考えていましたが、高度なオフィスでは、データの重複や整合性違反を排除するスマートツールとデータベースを使用しています。しかし、実際には、数十億ドル規模のプロジェクトを行っている大企業でも、請負業者とデータや技術文書を交換する際に「前後」モードでExcelを使用していることがわかりました。

このようなプロジェクトでは、数百の技術文書セットを同時に開発できます。たとえば、約4,500行のExcelスプレッドシートが添付されたドキュメントが定期的に送信され、各行で特定のドキュメントの現在のステータスが決定されます。特定のステータスに達したら、各ドキュメントを運用する必要があります。翻訳、合意、GOSTに適合など。

RedmineでExcelから同じタイプのこのようなタスクを直接実行し、テーブルのデータに従ってそれらを形成すると便利です。

上記のすべてに対して、私はすでにvbaで松葉杖を書く経験があり、頭の問題を解決するおおよその方法はすでに回転していました。

Redmine自体のインストールと構成については説明しません。このプロジェクト管理システムにまだ遭遇していない人は、デモを試すか、 bitnamiからスタックをダウンロードして実行できます。 Bitnami Redmine仮想マシンを操作するためのドキュメントは、ここにあります。

API情報のソースはRedmine APIです。

タスクを作成する簡単な例

そのため、Excelのvbaエディターに移動して、新しいモジュールを作成し、次のモジュールを入力します。

'  Redmine,      , '      url,     '       Const REDMINE_URL = "http://redmine_url" '      'Const REDMINE_URL = "http://user:password@redmine_url '    ,     PostIssue ' ( ,   ,        '   ,    ) Public issue_url, issue_id As String Sub Redmine_Create_Issue() Dim ReqStatus As Boolean Dim PROJECT_ID, TRACKER_ID, ASSIGNED_TO_ID, CATEGORY_ID As Integer Dim Subject, Body, DUE_DATE, REDMINE_API_KEY As String ' ID     Redmine '   ,      Redmine PROJECT_ID = 32 TRACKER_ID = 1 ASSIGNED_TO_ID = 20 'ID ,      '         Subject = " " Body = " " '     DUE_DATE = Format(ActiveSheet.Cells(ActiveCell.Row, 12), "yyyy-mm-dd") 'REDMINE_API_KEY = "e11234567891234567891234567891234567bce0" '   API key '        ReqStatus = PostIssue(PROJECT_ID, TRACKER_ID, ASSIGNED_TO_ID, Subject, Body, DUE_DATE, _ REDMINE_API_KEY, CATEGORY_ID) ' ,    If ReqStatus <> False Then MsgBox "Redmine: Ok,  " '      2      ActiveSheet.Cells(ActiveCell.Row, 2) = issue_id ActiveSheet.Hyperlinks.Add Range("B" & ActiveCell.Row), issue_url, "", _ " " & issue_url '      11   ) ActiveSheet.Cells(ActiveCell.Row, 11) = Date Else MsgBox "Redmine: ,   " End If End Sub '       xml Function PostIssue(ByVal PROJECT_ID As Integer, ByVal TRACKER_ID As Integer, _ ByVal ASSIGNED_TO_ID As Integer, ByVal Subject As String, _ ByVal Body As String, ByVal DUE_DATE As String, _ ByVal REDMINE_API_KEY As String, ByVal CATEGORY_ID As String) Dim xhr Dim RequestURL As String Dim RequestBody As String RequestURL = REDMINE_URL & "/issues.xml?format=xml" '   API key 'RequestURL = REDMINE_URL & "/issues.xml?format=xml&key=" & REDMINE_API_KEY Set xhr = CreateObject("Microsoft.XMLHTTP") xhr.Open "GET", RequestURL, False xhr.SetRequestHeader "Content-Type", "text/xml" RequestBody = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" RequestBody = RequestBody & "<issue>" RequestBody = RequestBody & "<project_id>" & PROJECT_ID & "</project_id>" RequestBody = RequestBody & "<tracker_id>" & TRACKER_ID & "</tracker_id>" RequestBody = RequestBody & "<assigned_to_id>" & ASSIGNED_TO_ID & "</assigned_to_id>" RequestBody = RequestBody & "<subject>" & Subject & "</subject>" RequestBody = RequestBody & "<description>" & Body & "</description>" RequestBody = RequestBody & "<due_date>" & DUE_DATE & "</due_date>" RequestBody = RequestBody & "</issue>" ' ,    xhr.Send (RequestBody) If xhr.Status = 201 Then PostIssue = True Else PostIssue = False End If '     issue_url = xhr.getResponseHeader("location") issue_id = Right(issue_url, Len(issue_url) - InStrRev(issue_url, "/")) End Function

注：Redmineでの認証には、ユーザー名とパスワード、またはプロファイルで表示できるAPIキーを使用できます。 上記の例では、ログインパスワードが使用され、キーのある行はコメント化されています。

すべて順調ですが、Redmineデータベースからしか学べないパラメーターはどうでしょうか？プロジェクト、トラッカー、およびタスクの割り当て先のIDを意味します。

私の場合、これらすべてのパラメーターはテーブルのデータ（プロジェクト、そのステータス、担当部門）に関連付けられているため、不正確ではありますが、普遍性の観点からしました。 RedmineデータベースのIDをphpMyAdminを介してスパイし、別のシートに設定プレートを作成し、メインテーブルから必要なパラメーターのIDを登録しました。その結果、ユーザーはテーブル内の目的の行を選択し、送信ボタンをクリックするだけで、追加のダイアログボックスは必要ありません。

わかりやすくするために実際のロジックを少し簡略化しましたが、意味は同じです。現在の行から値を取得し、テーブルをIDと比較します。

ご覧のように、私の場合、IDの入力は非常に多くなります。複数のサブプロジェクト、4つのトラッカー、およびタスクを最初に割り当てる部門の責任者が12人を少し超えるプロジェクトです。

したがって、代わりに：

 PROJECT_ID = 32 TRACKER_ID = 1 ASSIGNED_TO_ID = 20

私はこのような何かを書いた：

 PROJECT_ID = 0 TRACKER_ID = 0 ASSIGNED_TO_ID = 0 Set ID_WS = Application.ThisWorkbook.Sheets("ID") last_row = ID_WS.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To last_row If ActiveSheet.Cells(ActiveCell.Row, 3) = ID_WS.Cells(i, 2) Then PROJECT_ID = ID_WS.Cells(i, 3) End If If ActiveSheet.Cells(ActiveCell.Row, 4) = ID_WS.Cells(i, 5) Then TRACKER_ID = ID_WS.Cells(i, 6) End If If ActiveSheet.Cells(ActiveCell.Row, 10) = ID_WS.Cells(i, 8) Then ASSIGNED_TO_ID = ID_WS.Cells(i, 9) End If If PROJECT_ID <> 0 And TRACKER_ID <> 0 And ASSIGNED_TO_ID <> 0 Then Exit For Next

XMLの解析

より正確で複雑なアプローチは、必要なデータをRedmineから直接読み取ることです。ここで、APIが再び役立ちます。

次の機能が必要です。

XMLtoArrayは、指定されたノードから始まるxml解析関数です。追加のMicrosoft XMLライブラリの接続が必要です。だから誰かがそれを簡単にする方法を知っているなら、教えてください。

XMLtoArray

[ ツール] -> [ 参照]を介したMicrosoft XMLライブラリの接続

 Function XMLtoArray(ByVal RequestURL, ByVal ElementsByTagName As String, ByVal arr) As Variant '   xml      ' ElementsByTagName -  xml    ' arr -     Dim strXML As String Dim currNode As IXMLDOMNode If Not IsArray(arr) Then MsgBox "  !", vbCritical: Exit Function '     xml Set xhr = CreateObject("Microsoft.XMLHTTP") xhr.Open "GET", RequestURL, False xhr.SetRequestHeader "Content-Type", "text/xml" xhr.Send strXML = xhr.responseText '  xml '    Microsoft XML, v6.0 (Tools --> Reference) Set xmlParser = CreateObject("MSXML2.DOMDocument") If Not xmlParser.LoadXML(strXML) Then Err.Raise xmlParser.parseError.ErrorCode, , XDoc.parseError.reason End If Set colNodes = xmlParser.getElementsByTagName(ElementsByTagName) ReDim newarr(0 To colNodes.Length, 0 To UBound(arr)) N = 0 For Each node_item In colNodes For i = 0 To UBound(arr) If Not arr(i) Like "*@*" Then If Not IsNull(node_item.SelectSingleNode(arr(i))) Then newarr(N, i) = node_item.SelectSingleNode(arr(i)).Text End If Else For Each nodeChild In node_item.ChildNodes If part1(arr(i)) = nodeChild.nodeName Then newarr(N, i) = nodeChild.getAttribute(part2(arr(i))) If nodeChild.ChildNodes.Length > 0 Then p = 0 For Each nodeChildChild In nodeChild.ChildNodes If p = 0 Then newarr(N, i) = nodeChildChild.getAttribute(part2(arr(i))) Else newarr(N, i) = newarr(N, i) & "@" & nodeChildChild.getAttribute(part2(arr(i))) End If p = 1 Next End If End If Next End If Next N = N + 1 Next XMLtoArray = newarr End Function

SWAP -2次元配列の列置換関数（ここから取得）。

スワップ

 Function SWAP(ByVal arr As Variant, ByVal NewColumnsOrder$) As Variant '        arr (  ) '    NewColumnsOrder       ",,5,6,8,,9-15,18,2,9-11,,1,4,,21," '  ,        On Error Resume Next cols = Split(Replace(NewColumnsOrder$, " ", ""), ","): Dim n As Long: ReDim colArr(0 To 0) For i = LBound(cols) To UBound(cols) Select Case True Case cols(i) = "", Val(cols(i)) < 0 colArr(UBound(colArr)) = -1: ReDim Preserve colArr(0 To UBound(colArr) + 1) Case IsNumeric(cols(i)) colArr(UBound(colArr)) = cols(i): ReDim Preserve colArr(0 To UBound(colArr) + 1) Case cols(i) Like "*#-#*" spl = Split(cols(i), "-") If UBound(spl) = 1 Then If IsNumeric(spl(0)) And IsNumeric(spl(1)) Then For j = Val(spl(0)) To Val(spl(1)) Step IIf(Val(spl(0)) > Val(spl(1)), -1, 1) colArr(UBound(colArr)) = j: ReDim Preserve colArr(0 To UBound(colArr) + 1) Next j End If End If End Select Next i ReDim Preserve colArr(0 To UBound(colArr) - 1) ColumnsArray = colArr ReDim tmpArr(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To UBound(ColumnsArray) + 1) For j = LBound(ColumnsArray) To UBound(ColumnsArray) If Val(ColumnsArray(j)) >= 0 Then For i = LBound(arr, 1) To UBound(arr, 1): tmpArr(i, j + LBound(arr, 2)) = arr(i, Val(ColumnsArray(j))): Next i End If Next j SWAP = tmpArr End Function

これで、Redmineでクエリを作成できます。

プロジェクトのリスト：

 RequestURL = REDMINE_URL & "/projects.xml?include=trackers" Arr_childNodes_projects = Array("id", "name", "trackers@id", "trackers@name", _ "identifier", "description", "parent@id", "parent@name", _ "status", "is_public", "created_on", "updated_on") Arr_projects = XMLtoArray(RequestURL, "project", Arr_childNodes_projects) Arr_projects_SWAP = SWAP(Arr_projects, 1)

出力では、受信したすべてのデータを含む配列と、必要な列のみを含む切り捨てられたSWAP配列（この場合、ユーザーのフォームに表示できるプロジェクトの名前）の2つの配列を取得します。

同様に、次のものが得られます。

タスクのステータス

 RequestURL_status = REDMINE_URL & "/issue_statuses.xml" Arr_childNodes_status = Array("id", "name", "is_closed") Arr_statuses = XMLtoArray(RequestURL_status, "issue_status", Arr_childNodes_status) Arr_statuses_SWAP = SWAP(Arr_statuses, 1)

タスクの優先順位

 RequestURL_priorities = REDMINE_URL & "/enumerations/issue_priorities.xml" Arr_childNodes_priorities = Array("id", "name", "is_default") Arr_priorities = XMLtoArray(RequestURL_priorities, "issue_priority", Arr_childNodes_priorities) Arr_priorities_SWAP = SWAP(Arr_priorities, 1)

プロジェクト参加者

 RequestURL_memberships = REDMINE_URL & "/projects/" & Arr_projects(i, 0) & "/memberships.xml?limit=300" Arr_childNodes_memberships = Array("user@id", "user@name", "project@id", "project@name", "roles@id", "roles@name") Arr_memberships = XMLtoArray(RequestURL_memberships, "membership", Arr_childNodes_memberships) Arr_memberships_SWAP = SWAP(Arr_memberships, 1)

ここで、 Arr_projects（i、0）は特定のプロジェクトのIDです 。

プロジェクトの目的

 RequestURL_issues = REDMINE_URL & "/issues.xml?project_id=" & Arr_projects(i, 0) Arr_childNodes_issues = Array("id", "subject") Arr_issues = XMLtoArray(RequestURL_issues, "issue", Arr_childNodes_issues) Arr_issues_SWAP = SWAP(Arr_issues, "0,1") ComboBox_parent_issue.List = Arr_issues_SWAP

ここで、 Arr_projects（i、0）は特定のプロジェクトのIDです 。

このデータは、たとえば次の形式を使用して、タスク作成機能を実装するのに十分です。

このフォームは、官僚向けの印刷および署名ジョブの並行生成を使用して、Wordの下で行われました（vbaコードはExcelでも同じであるため、本質は変わりません）。しかし、これは彼らが言うように、別の話です。

Excel全能とRedmine：Excelでタスクを直接生成する方法

これはなぜですか？

タスクを作成する簡単な例

XMLの解析

More articles: