うちの会社では、年始になるとほとんどのお客さんに資料を送付する、という業務が発生します。
具体的な数はわからないんですが、全顧客が900社ぐらいですので、
少なく見積もっても半分の450社には送ってますね。
資料を送るときにめんどくさいのが
「宛名を書く」
ということなのですが、非IT企業であるからか、みんなそこは根性で書ききってます。
たまに宛名シールをうまく活用している人もいるのですが、
宛名シールを印刷するエクセルやワードにひたすらコピペを繰り返してるとのことでした。
めっちゃめんどくさいことしてるなーと思いつつ、今まではそのままにしてたんですが、
ちょっと僕も手伝うことになってきたので思い切ってツールを作りました。
とは言えそんなに仰々しいものではなく、
顧客リストに新たに列を作り、
そこに数字が入ってたら印刷シートにコピペする、
そして印刷！という簡単なものです。
全体のコードはこんな感じ。
Sub printLabel()
Dim ws_main As Worksheet
Dim ws_print As Worksheet
Dim last_row As Variant
Dim print_row As Variant
Dim print_column As Variant
Dim page_count As Variant
Dim cnt As Variant
Dim i As Integer
Set ws_main = Worksheets("顧問先")
Set ws_print = Worksheets("印刷")
last_row = ws_main.Range("A1048576").End(xlUp).Row
print_row = 1
print_column = 1
cnt = 0
ws_print.Range("A:G").ClearContents
For i = 2 To last_row
page_count = ws_main.Cells(i, 11).Value
If page_count <> 0 Then
ws_print.Cells(print_row, print_column).Value = ws_main.Cells(i, 2).Value
ws_print.Cells(print_row + 1, print_column).Value = ws_main.Cells(i, 3).Value & ws_main.Cells(i, 4).Value
ws_print.Cells(print_row + 2, print_column).Value = ws_main.Cells(i, 5).Value
ws_print.Cells(print_row + 4, print_column).Value = ws_main.Cells(i, 6).Value & " " & ws_main.Cells(i, 7).Value
print_column = print_column + 2
If print_column = 9 Then
print_column = 1
cnt = cnt + 1
If cnt = 5 Then
print_row = print_row + 5
cnt = 0
Else
print_row = print_row + 6
End If
End If
End If
Next
ws_print.PrintOut
End Sub
一番ややこしかったのが、
「宛名シールのサイズに合わせて出力する」
ということであり、コードより見た目の調整にめっちゃ時間かかりました(笑)
ただ、その調整があまりにも難しかったので完璧に宛名シールと一致はしておらず、
そのせいか微調整のための列を入れたり、
宛名シールの1枚目から2枚目に印刷範囲が移動するあたりの行を設定する、
というコードがややこしかった…
ちなみにエクセルはこんな感じ。
これが顧客リスト。
これが印刷されるシート。
この、印刷されるシートの29行目から30行目(宛名シールの1枚目から2枚目)にいくとき、
通常は6行で1会社なんですが、宛名シールの最後だけ5行で1会社なんですよね。
それがややこしかった…
宛名シールのサイズにちょうど合うように設定してからやればいいんでしょうけど、
その時間がなかったので暫定ということで…
業務改善のためのツール作りが一番楽しいな～