« Trac->MS-Project連携のフロー | トップページ | TracのXMLRPCを拡張してみる »

2009年9月27日 (日)

Tracの情報をもとにExcelで作ったレポートをPDF化し,Tracのチケットに添付してしまうところまでを自動化したい.

Excel2007を使用した場合は,ExportAsFixedFormatを使用して簡単にPDFが作成できるということがわかったので,レポートをPDF化し,Tracのチケットに添付してしまおうということでやってみました.まずBase64のエンコードを作ってみました.VBAだとシフトは使えないし,型変換では丸められるしでだいぶ苦労しました.XML-RPCを使いファイルを添付するところまでやってみました.まぁ.レポートの作成は運用でだいぶ違うと思いますので,そのままは使えませんが,VBAの分かる方は参考にしてみてください.

VisualBasicTracConnector に登録しておきます.

レポートを作成するところはTracXMLRPC.clsを使って進捗報告のレポートを作成する例を参考にしていただくとして,変換のところは

Private Function encodeBase64Byte(d As Long) As Long
    If d < 26 Then
        encodeBase64Byte = Asc("A") + d
    ElseIf d < 52 Then
        encodeBase64Byte = Asc("a") + (d - 26)
    ElseIf d < 62 Then
        encodeBase64Byte = Asc("0") + (d - 52)
    ElseIf d < 63 Then
        encodeBase64Byte = Asc("+")
    ElseIf d < 64 Then
        encodeBase64Byte = Asc("/")
    Else
        Debug.Print "Error"
    End If
End Function

Private Function encodeBase64(ByRef buf() As Byte, fileSize As Long) As String
    Debug.Print UBound(buf)
    encodeBase64 = ""
    Dim pos As Long
    For pos = 0 To UBound(buf) - 1 Step 3
        Dim l As Long, l2 As Long
        Dim d(4) As Long
        Dim e(4) As Long
        l = (buf(pos)) * (2 ^ 16) + (buf(pos + 1)) * (2 ^ 8) + (buf(pos + 2))
        d(1) = CLng((l And (63 * 2 ^ 18)) / (2 ^ 18))
        d(2) = CLng((l And (63 * 2 ^ 12)) / (2 ^ 12))
        d(3) = CLng((l And (63 * 2 ^ 6)) / (2 ^ 6))
        d(4) = CLng((l And 63) And 63)
        e(1) = encodeBase64Byte(d(1))
        e(2) = encodeBase64Byte(d(2))
        e(3) = encodeBase64Byte(d(3))
        e(4) = encodeBase64Byte(d(4))
        If fileSize - pos = 2 Then
            e(4) = Asc("=")
        ElseIf fileSize - pos = 3 Then
            e(3) = Asc("=")
            e(4) = Asc("=")
        End If
        encodeBase64 = encodeBase64 + Chr(CByte(e(1))) + Chr(CByte(e(2))) + Chr(CByte(e(3))) + Chr(CByte(e(4)))
    Next
End Function

ファイルを読み込むところは,変換の単位が3文字ごとなので3文字の倍数のバッファを用意しています.トラックとのやり取りはTracHacksで見ていただいたほうがいいでしょうが,追加したところだけ貼り付けておきます.

Public Function putAttachment(id As Long, path As String, fileName As String, description As String) As String
    Dim n As Long, base64 As String, fileSize As Long
    n = FreeFile
    fileSize = FileLen(path)
    Dim buf() As Byte
    ReDim buf(Int((fileSize + 2) / 3) * 3)
    Open path For Binary As #n
        Get #n, , buf
    Close #n
   
    putAttachment = putAttachment_sub(id, fileName, description, encodeBase64(buf, fileSize))
End Function

Public Function putAttachment_sub(id As Long, fileName As String, description As String, data As String) As String
    Dim funcName As String, params As String, dataType As String
    Dim ret As Collection
    funcName = "ticket.update"
    params = _
            "<param><value><i4>" & id & "</i4></value></param>" & vbCrLf & _
            "<param><value><string>" & fileName & "</string></value></param>" & vbCrLf & _
            "<param><value><string>" & description & "</string></value></param>" & vbCrLf & _
            "<param><value><base64>" & data & "</base64></value></param>" & vbCrLf & _
            "<param><value><boolean>1</boolean></value></param>"
'    Debug.Print params
    Set Members = getMember("ticket.putAttachment", params, "string")
    If Members Is Nothing Then
        Exit Function
    End If
    If Members.Length = 0 Then
        Exit Function
    End If
    For i = 0 To Members.Length - 1
        Set Item = Members.Item(i)
        putAttachment_sub = Item.text
'        d.Add name
'        Debug.Print "-" & name & "(" & typeName & ")"
        yield
    Next
End Function

TracXMLRPC.clsを呼ぶところはExportAsFixedFormatを呼んででPDF作ったあとに,putAttachment呼んでいるだけです.

Sub test()
    Dim user As String, pw As String, URL As String, projectName As String, query As String
    Dim devTrac As TracXMLRPC
   
    Dim settingSheet As Worksheet
    Set settingSheet = Sheet1
    URL = settingSheet.Cells(2, 3).value
    user = settingSheet.Cells(6, 3).value
    pw = settingSheet.Cells(7, 3).value
    projectName = settingSheet.Cells(3, 3).value
   
    Set devTrac = New TracXMLRPC
    devTrac.init URL, projectName, user, pw
   
    Dim fileName As String, reportSheet As Worksheet
    Set reportSheet = Application.ActiveWorkbook.Sheets.Item("Report")
    fileName = ActiveWorkbook.path & "\test.pdf"
    reportSheet.ExportAsFixedFormat xlTypePDF, fileName, xlQualityStandard, True, True

    devTrac.putAttachment 1, fileName, "test.pdf", "進捗"
End Sub

|

« Trac->MS-Project連携のフロー | トップページ | TracのXMLRPCを拡張してみる »

Trac」カテゴリの記事

Excel」カテゴリの記事

XMLRPC」カテゴリの記事

コメント

コメントを書く



(ウェブ上には掲載しません)


コメントは記事投稿者が公開するまで表示されません。



トラックバック


この記事へのトラックバック一覧です: Tracの情報をもとにExcelで作ったレポートをPDF化し,Tracのチケットに添付してしまうところまでを自動化したい.:

« Trac->MS-Project連携のフロー | トップページ | TracのXMLRPCを拡張してみる »