選択行のデータをTSVテキストに変換するExcelアドイン
脱Excelができない理由の一つとして、情シスやパッケージで導入したシステムの力量不足が挙げられます。前者の場合は開発者自身の力量不足と責任回避の為、後者の場合は主に予算の都合でカットされる。その為、実際の現場の業務との差を埋めてくれるのは、他でもないExcelであり、時には基幹業務システムの1部を担うことも珍しくありません。
そんなケースに於いて、Excelのデータを基幹業務システムでインポートできる形式に変換してといった作業があります。1個2個程度ならVBAなど書かなくても良いですが、利用者が多数で利用頻度も高いとなるとプログラムを作る必要があります。今回もSAP HANA上にローカルデータを取り込む為のものを作る事になりました。(API叩いて流しこめばいいじゃんって思ったそこのあなた。それ金融系のコンサル会社の担当にも言ってあげて下さい)
今回はSAP向けにTSV形式でExcelのデータを変換して出力するアドインを作ってみました。
目次
今回利用するファイル等
アドイン形式であるxlamで作成しているので、導入が必要になります。また、出力されるtextファイルはTSV形式で、文字コードはShift-JIS形式としています(VBA内のオプションを変更すれば、UTF-8での出力も確認済みです)。
事前準備
今回のファイルはアドイン形式であるため、利用する為にはいくつかの準備が必要になります。アドインですので、単体では動作しません。手順に従って導入する事で、全てのExcelファイルで利用する事ができるようになります。
開発タブを表示する
- メニューより「ファイル」⇒「オプション」を開きます。
- 左側サイドバーより「リボンのユーザ設定」をクリックします。
- 右側のリボンのユーザ設定内に「開発」があり、チェックが外れていると思うので、チェックを入れてあげます。
- OKボタンを押して完了
図:開発タブを表示しないと導入できない
アドインを導入する
- アドインは自分のマイドキュメントの「ドキュメントフォルダ」にでも入れておきましょう(デスクトップだと失くす可能性があるため)
- Excelの「開発タブ」を開きます。
- 「Excelアドイン」をクリックします。
- アドインダイアログが出たら、「参照」をクリックします。
- ファイルの参照ダイアログが出てきます。右下の「アドイン(*.xlam, *.xla, *.xll)」の部分は、「すべてのファイル(*.*)」に変更します。
- 1.で保存したtabusaku.xlamを見つけてOKボタンを押します。
- これで追加完了。OKボタンを押して終了です
- リボンの所に「タブ作君」というタブが出てくるようになり、「TSVへ変換出力」のボタンが追加されているはずです。
図:アドイン追加ダイアログ
参照設定の追加
アドインとして作る場合、以下のモジュールを参照設定に追加しておく必要があります。アドインを使うだけの人は特に何も作業は必要ありません。この設定はこのアドインを作成するプログラマの作業になります。
- Microsoft ActiveX Data Object 6.1 Library - テキストデータの書き出し時に利用する
- Microsoft Office 16.0 Object Library - リボンで利用する
- Microsoft Scripting Runtime - 連想配列のDictionaryやファイルの有無、特殊フォルダの取得などで利用する
図:参照設定が必要になります
使い方
このアドインは以下のような機能を持っています。
- 添付してある見本のExcelファイルのような形式の時に、選んだ行(Ctrlキーで飛ばして行選択も対応)だけをTAB区切りテキストとして出力します。
- 出力先はデフォルトではシート名(デスクトップを指定)がファイル名になりますが、変更する事が可能です。
- タイトル行(項目名のある行)を含めた場合には、その行も出力されます。ヘッダーありの場合にはタイトル行も選択行に含めてください。
- 出力したデータは、Shift-JIS形式のTAB区切りテキストです(CSVではありません)
- 復数行を選んだら、「タブ作君」というタブ内にある「TSVへ変換出力」をクリック、保存先を聞いてくるので、選んでOKで出力完了です。
- 普通のテキストファイルなのでメモ帳などで中身を確認する事が可能です。
図:行選択してこのボタンを押す
ソースコード
リボンのXMLコード
1 2 3 4 5 6 7 8 9 10 11 12 |
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui" onLoad="OnLoad"> <ribbon> <tabs> <tab id="SampleTab" label="タブ作君" getVisible="Tab_getVisible"> <group id="toolgroup" label="変換ツール" centerVertically="true"> <button id="customButton" label="TSVへ
変換出力" image="niku" size="large" onAction="changeman" /> </group> </tab> </tabs> </ribbon> </customUI> |
- nikuというイメージファイルを埋め込んであります。
- ボタンクリック時には、changemanというコードが実行される仕組みです。
- ファイル読み込み時には、OnLoadというコードが実行され、リボンの初期化が実行されます。
- 今回のコードは、Custom Ribbon UI Editorを使って作成しています。
リボン初期化のコード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Public m_ribbon As IRibbonUI 'リボン起動時に初期化するコード Public Sub OnLoad(ribbon As IRibbonUI) 'リボンのインスタンスを取得 Set m_ribbon = ribbon '自作のリボンをアクティブにする m_ribbon.ActivateTab ("SampleTab") End Sub 'タブの表示状態を取得する Public Sub Tab_getVisible(control As IRibbonControl, ByRef returnedVal) '常にタブを表示する returnedVal = True End Sub 'リボン用直接実行関数 Public Sub changeman(control As IRibbonControl) Call tsvconverter End Sub |
- リボンを初期化するOnLoadのコマンド及び変換実行のchangemanのコードです
メインのVBAコード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 |
'現在アクティブで選択されている行だけをUTF8のTSVファイルとして出力するコード Public Function tsvconverter() '現在アクティブになってるシート名を取得する Dim activesheetman As String activesheetman = ActiveSheet.Name '// シートの入力範囲の全セルを取得 Dim rUsed As Range Set rUsed = ActiveSheet.UsedRange '行選択されているかどうかチェック Dim lineman As Boolean lineman = line_check() If lineman = False Then '行選択されていないので終了 MsgBox "行選択されていませんよ" Exit Function End If 'ユーザのデスクトップパスを取得する Dim Path As String, WSH As Variant Set WSH = CreateObject("WScript.Shell") Path = WSH.SpecialFolders("Desktop") Set WSH = Nothing 'ファイルの出力先を指定 Dim savepath As Variant savepath = Application.GetSaveAsFilename(InitialFileName:=Path & "" & activesheetman & ".txt", FileFilter:="TAB区切りテキスト,*.txt") 'フォルダ選択がキャンセルされた場合 If savepath = False Then MsgBox "保存場所の指定がキャンセルされました。" Exit Function End If 'テキスト出力用の変数 Dim ts As TextStream Dim fs As New FileSystemObject Dim s Dim iRow iRow = 0 '現在選択されている行を取得する Dim rng As Range Dim r As Range Dim cnt As Integer cnt = 1 '選択行カウント用の配列を用意 Dim Member As Dictionary Set Member = New Dictionary '選択行の行番号連想配列に追加する Dim test As Variant For Each rng In Selection.Rows '行番号を入れる test = rng.Row Member.Add cnt, test 'カウンタを追加する cnt = cnt + 1 Next rng '1セルずつループ Dim firstflg As Boolean firstflg = True Dim varResult As Variant Dim execflg As Boolean execflg = False '連想配列処理用変数 Dim dicman As Integer Dim tempdic As Variant dicman = Member.Count For Each r In rUsed '現在の行番号が配列にいるかどうかチェック For i = 0 To dicman '要素を取り出す tempdic = Member.Item(i) '行番号とdictionaryの値が一致してたらフラグを立てる If tempdic = r.Row Then execflg = True Exit For End If Next i '戻り値配列のサイズで要素の有無を判定 If execflg = True Then '指定行なのでデータの処理を行なう If iRow <> r.Row Then '// ループ初回時ではない場合 If firstflg = False Or r.Column <> rUsed.Column Then '// 行が変わったため改行コードを付与 s = s & vbCrLf Else firstflg = False End If '// 行の先頭値を連結 s = s & r.Text Else '// タブ文字区切りで連結 s = s & vbTab & r.Text End If Else '配列にいない行なのでスルーする End If '現在行番号を取得 iRow = r.Row 'フラグを初期化 execflg = False Next 'ADODB.streamによるUTF-8形式での出力 Dim output As ADODB.Stream Set output = New ADODB.Stream 'セルの文字列が存在する場合TXTを書き込みする If s <> "" Then 'Shift-JISで出力する(UTF-8を指定するとUnicodeになる) With output 'Shift-JISで設定して開く .Type = adTypeText .Charset = "Shift-JIS" .LineSeparator = adLF .Open End With 'ファイルの書き出し With output '出力内容を書き出し .WriteText s, adWriteLine 'ファイルを保存する .SaveToFile savepath, adSaveCreateOverWrite '閉じる .Close End With End If '終了処理 'Call ts.Close MsgBox "データをテキスト形式に変換しましたよ!" End Function '行選択されているかどうかチェック Public Function line_check() As Boolean '変数の宣言 Dim lineadd As String lineadd = Selection.Address(False, False) lineadd = Replace(lineadd, ":", "") '選択行かどうかを確認 If IsNumeric(lineadd) Then line_check = True Else line_check = False End If End Function |