Redmine から Excel にエクスポートしてみた。
10月 10th, 2010 by mattari
Redmine のチケットは一覧から CSV に出力することができますが、履歴が出力されないので微妙に不便です。
同じようなことを考えている方が多いようで、”Redmine CSV 履歴” で検索すると対策が見つかりました。
で、どうせなので、キレイな Excel シートになるように、マクロ作ってExcelテンプレート(xlt)にしてみました。
マクロを実行すると、こんな感じのエクセルになります。
ついでに、↓のようにテンプレートにチケットの状態名を書いて「セルの書式の設定」で背景色を指定すると、結果のエクセルに反映されるようにしてみました。
コードはこんな感じです。Excel で Visual Basic Editor を開き、Sheet1 にコピペしてから、テンプレート(xlt) で保存すれば使えます。
Sub prcApplicationGetOpenFilename()
Dim file_name As Variant
Dim book As Workbook
Dim sheet_name As String
Dim sheet As Worksheet
‘ファイルを開くダイアログを開きます
file_name = _
Application.GetOpenFilename( _
FileFilter:="エクセルファイル(*.csv),*.csv" _
, FilterIndex:=1 _
, Title:="インポート" _
, MultiSelect:=False _
)‘ファイルを開く
If file_name <> False Then
Set book = Workbooks.Open(Filename:=file_name)
End If
‘ フォーマットするシート名を求める
sheet_name = Dir(file_name)
If InStr(1, sheet_name, ".") > 0 Then
‘拡張子がある場合は、拡張子を省く
sheet_name = Left(sheet_name, InStrRev(sheet_name, ".") – 1)
End If
Set sheet = book.Worksheets(sheet_name)‘ フォーマットする
Call prcFormatting(sheet)
End Sub
Sub prcFormatting(sheet As Worksheet)Dim row As Long
Dim max_row As Long
Dim col As Long
Dim max_col As Long
Dim my_col As Long
Dim width_array As Variant
Dim default_width As Integer
‘ カスタムフィールドがある場合は、この配列の後ろにセル幅を追記してください。
‘ セル幅定義 1***********5*************10****************15*****************20
width_array = Array(4, 8, 8, 8, 7, 40, 10, 8, 10, 10, 10, 10, 4, 4, 4, 15, 15)
‘ 幅
default_width = 40
‘ セル範囲
max_row = sheet.Range("A65536").End(xlUp).row
max_col = ActiveCell.CurrentRegion.Columns.Count
‘ シート全体の調整
sheet.Range(sheet.Cells(1, 1), sheet.Cells(max_row, max_col)).HorizontalAlignment = xlHAlignLeft
sheet.Range(sheet.Cells(1, 1), sheet.Cells(max_row, max_col)).VerticalAlignment = xlVAlignTop
sheet.Range(sheet.Cells(1, 1), sheet.Cells(max_row, max_col)).WrapText = True
‘ ボーダーの設定
sheet.Range(sheet.Cells(1, 1), sheet.Cells(max_row, max_col)).Borders(xlEdgeLeft).LineStyle = xlContinuous
sheet.Range(sheet.Cells(1, 1), sheet.Cells(max_row, max_col)).Borders(xlEdgeTop).LineStyle = xlContinuous
sheet.Range(sheet.Cells(1, 1), sheet.Cells(max_row, max_col)).Borders(xlEdgeRight).LineStyle = xlContinuous
sheet.Range(sheet.Cells(1, 1), sheet.Cells(max_row, max_col)).Borders(xlInsideVertical).LineStyle = xlContinuous
sheet.Range(sheet.Cells(1, 1), sheet.Cells(max_row, max_col)).Borders(xlEdgeBottom).LineStyle = xlContinuous
sheet.Range(sheet.Cells(1, 1), sheet.Cells(max_row, max_col)).Borders(xlInsideHorizontal).LineStyle = xlContinuous‘ ヘッダの調整
sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, UBound(width_array) + 1)).ColumnWidth = width_array
sheet.Range(sheet.Cells(1, UBound(width_array) + 2), sheet.Cells(1, max_col)).ColumnWidth = default_width
sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, max_col)).Interior.ColorIndex = ThisWorkbook.Sheets(1).Cells(6, 1).Interior.ColorIndex
sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, max_col)).Font.ColorIndex = ThisWorkbook.Sheets(1).Cells(6, 1).Font.ColorIndex
sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, max_col)).Font.Bold = True
sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, max_col)).HorizontalAlignment = xlCenter
sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, max_col)).VerticalAlignment = xlCenter
sheet.Range("A1").AutoFilter
sheet.Rows(1).AutoFit
‘ ちらつき防止
Application.ScreenUpdating = False
For row = max_row To 2 Step -1
‘ チケット番号が空の行を削除する
If IsEmpty(sheet.Cells(row, 1)) Then
sheet.Range(row & ":" & row).Delete
Else
‘ 色設定を取得する
Set FR = ThisWorkbook.Sheets(1).Range("A7:A16").Find(sheet.Range("B" & row).Text)
If Not FR Is Nothing Then
my_col = FR.Interior.ColorIndex
End If‘ データのある行に色を付ける
sheet.Range(sheet.Cells(row, 1), sheet.Cells(row, max_col)).Interior.ColorIndex = my_col
End If
Next row
End Sub
いちおう出来上がりも置いておきます。
redmine2excel.xlt
