[Из песочницы] Excel «Всемогущий» и Redmine: как генерировать задачи прямо в Excel22.12.2016 13:49

3891b0e86c384484992b8334c2645886.png

В далёких от IT проектных организациях Excel часто используется в качестве инструмента обработки бог весть каких данных.

Передо мной встала задача в очень сжатые сроки наладить в Excel мониторинг весьма специфичного проекта с попутной выдачей заданий в проектные отделы. Касательно мониторинга ТЗ было более-менее определено и весь функционал был реализован средствами VBA самого Excel.

С выдачей заданий всё было не так однозначно. Поскрипев креслом, я решил попробовать отправлять задачи в Redmine прямо из Excel, получая обратно гиперссылку и номер задачи.

Статья написана инженером-проектировщиком для таких же новичков в программировании, автоматизирующих подручными средствами рутинную работу. Буду рад любым замечаниям!

Зачем это вообще?


Так получилось, что Excel в отрасли проектирования де-факто такой же стандарт при обмене между сотрудничающими организациями всевозможными списками документации и спецификациями, как и AutoCAD для чертежей.

Раньше я думал, что так только в нашей организации, а продвинутые конторы используют умные инструменты и базы, исключающие дублирование и нарушения целостности в данных. Но на деле оказалось, что даже большие компании на многомиллиардных проектах используют Excel в режиме «туда-сюда» при обмене данными и технической документацией с контрагентами.

В таких проектах одновременно в разработке могут быть сотни комплектов технической документации. К нам, например, регулярно присылают документы с прилагаемой экселевской таблицей на ~4500 строк, где каждая строка определяет текущий статус конкретного документа. При достижении определенного статуса каждый документ должен быть запущен в работу: переведён, согласован, адаптирован под ГОСТ и т.д.

Такие однотипные задачи удобно запускать в Redmine прямо из Excel, формируя их в соответствии с данными из таблицы.

Ко всему выше сказанному, какой-никакой опыт написания костылей на vba у меня уже был, и примерный путь решения проблемы в голове уже крутился.

Я не буду подробно останавливаться на установке и настройке самого Redmine. Те, кто ещё не сталкивался с этой системой управления проектами, могут попробовать demo, или скачать и запустить стак от bitnami. Документацию по работе с виртуальной машиной Bitnami Redmine можно посмотреть тут.

Источник информации по API — Redmine API.

Простой пример создания задачи


Итак, заходим в редактор vba в Excel, создаем новый модуль и вписываем в него следующее: 
' Пользователя 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 = ""
    RequestBody = RequestBody & ""
    RequestBody = RequestBody & "" & PROJECT_ID & ""
    RequestBody = RequestBody & "" & TRACKER_ID & ""
    RequestBody = RequestBody & "" & ASSIGNED_TO_ID & ""
    RequestBody = RequestBody & "" & Subject & ""
    RequestBody = RequestBody & "" & Body & ""
    RequestBody = RequestBody & "" & DUE_DATE & ""
    RequestBody = RequestBody & ""

    ' Проверяем, что задача отправлена
    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 для проекта, трекера, и на кого назначена задача.

В моем случае все эти параметры связаны с данными из таблицы (проект, его статус, ответственный отдел), поэтому я поступил просто, хоть и неправильно с точки зрения универсальности. Я подсмотрел ID в базе Redmine через phpMyAdmin и создал на отдельном листе табличку настроек, где прописал эти ID для нужных мне параметров из основной таблицы. Как результат, пользователю нужно только выбрать нужную строку в таблице и нажать кнопку отправки задачи, никаких дополнительных диалоговых окон.

Я немного упростил реальную логику для наглядности, но смысл тот же — берем значение из текущей строки и сравниваем по таблице с ID.

a6feff8f4f2049dfacb95a416200c951.PNG

Как видите, в моем случае вписывать ID совсем немного: проект с несколькими подпроектами, четыре трекера, и чуть больше дюжины ответственных руководителей отделов, на которых изначально должна назначаться задача.

Таким образом, вместо: 

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 через Tools --> Reference

6e7b7bf3bcd04c52927953fb29cf4770.PNG

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 — функция перестановки столбцов в двумерном массиве (взял отсюда).
SWAP
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 массив только с нужными нам столбцами, в данном случае, с именами проектов, которые можно выводить в форму для пользователя.

Аналогичным образом получаем:

Статусы задач
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 конкретного проекта.

Этих данных вполне достаточно для реализации функционала создания задачи, например, при помощи такой формы:

1b71c2d0b83845e685e376859d22ced3.png

Эта форма делалась под Word (сути не меняет, так как код vba тот же и в Excel) для другого проекта, с параллельной генерацией задания на печать и подпись для наших бюрократов. Но это, как говорится, уже другая история.

Комментарии (2)

  • 22 декабря 2016 в 13:38

    +1

    ↑

    ↓

    Я как-то делал систему управления проектами + таск-трекер в Excel без всяких Redmine:)
    Перечень проектов, активность
    image

    Таблица заявок-задач
    image

    Трудозатраты по задачам
    image

    Текущие задачи сотрудников
    image

    Активность сотрудников, задачи-висяки
    image

    Активность сотрудников в динамике
    image

    • 22 декабря 2016 в 13:44

      0

      ↑

      ↓

      Ещё персонального помощника для неопределенных жизненных ситуаций :)

© Habrahabr.ru