箸休め_6

nJun Excel VBA 職人

2024年1月14日 22:05

今回は「宛名シール」を作ってみましょう。
箸休め1で作った住所録を市販のラベルシールに出力します。

今回の準備は、Excelの空白Bookを開いて三つのシートを作ってください。
まずは、2枚目3枚目のシートを下図のように作り、シート名「シール1」「シール2」としてください。

実際は、使用するラベルシールの様式に合うようにセルの高さや幅を微調整しなければなりませんが、ここでは大体のイメージとして2タイプ作っています。

そして、1枚目のシートはシート名「操作卓」として実行ボタン等を作成してください。
また、K列を非表示にしてください。8行目D列はシート名の入力エリアとして使用します。

ここまでを一旦保存して終了しましょう。
Book名を「ラベルシール.xlsm」保存先を練習2(シート住所録)と同じFolder（またはDesktop）にしてください。

それでは「ラベルシール.xlsm」を開いて、コーディングを始めます。
まず、８行目D列にプルダウンリストを設定するためのProcedureを作ります。
箸休め5の Sub PDL が参考になりますので

With Sheets("アルバム").Cells(3, ”F").Validation
    .Delete   '既存のPullDown_LISTをDEL
　  .Add Type:=xlValidateList, Formula1:="=操作卓!$H4:$H$" & LR '新規のPullDown_LISTをPUT
End With

をコピーしましょう。（マクロ名はSub PDL()で良いです）

今回の選択肢はシート名で、そのシート名をK列に取り込む予定です。
Sub PDL()内の冒頭から入力を始めてください。
最初にシートの数を調べて、２枚目から最後のシートまでのシート名をK列に取込んでいきましょう。
コーディングの見当はつきましたか？
プルダウンリストを設定する対象セルは8行目D列、選択肢はK列にあるので先ほどコピーした部分の必要項目を修正すれば完成です。

Sub PDL()

    Range("K:K") = "" 'K列内容消去
    Sc = Sheets.Count
    For n = 2 To Sc: Cells(n, "K") = Sheets(n).Name: Next n

    With Cells(8, "D").Validation
        .Delete         '既存のPullDown_LISTをDEL
        .Add Type:=xlValidateList, Formula1:="=$K2:$K$" & Sc '新規のPullDown_LISTをPUT
    End With

End Sub

ここまでは、順調にできたかと思いますが、いかがですか？
今回のメインは、住所録のデータから宛名シールを作ることです。
これは「VBAでBarCode_出力」で作った Sub 個票() を参考にしましょう。マクロ名をSub ラベル()として、

Sub ラベル()

    For n = 1 To 10

      a = Fix((n - 1) / 2) * 8 + 2
      b = (n - Fix((n - 1) / 2) * 2 - 1) * 4 + 1

      Sheets("社員証").Cells(a, b + 1) = Cells(n + 5, "B")  '社員№
      Sheets("社員証").Cells(a, b + 3) = Cells(n + 5, "D")  '部署№
      Sheets("社員証").Cells(a + 1, b + 1) = Cells(n + 5, "C") '社員名
      
      BC = "241" & Cells(n + 5, "D") & Cells(n + 5, "B")
      Sheets("社員証").Cells(a + 5, b + 1) = BC 'BC№

    Next n
    Sheets("社員証").Select

End Sub

の部分をコピーしてください。
今回は、様式が二つ（シール1、シール2）あるので、汎用的に使えるように大改造を行います。（誇張表現？）

まず a = Fix((n - 1) / 2) * 8 + 2
　　 b = (n - Fix((n - 1) / 2) * 2 - 1) * 4 + 1　に着目します。

aは行、bは列を表していますので分かり易いように、変数名をそのまま「行」「列」とします。
シール1をブロック単位で見ると、横に2ブロックあって、7行下に次（三つ目）のブロックがあります。そして最初のブロックが2行目から始まっています。これらの定数をそれぞれ変数に変えましょう。
　行= Fix((n - 1) / R) * J + ga　とすると、横にRブロックあって、J行下に次のブロックがきて、最初のブロックがga行目から始まる。となります。
同様に、列については
　列= (n - Fix((n - 1) / R) * R - 1) * S +ra　とすると、横にRブロックあって、S列右に次のブロックがきて、最初のブロックがra列から始まる。となります。
こうしておくと、ラベルの様式に合わせて変数の値を設定することにより、一つの算式を汎用的に使うことが可能となります。

今回の場合は、シート名により様式を判別できるので
If Cells(8,"D")="シール1" Then
　R = 2: J = 7: S = 5: ga = 3: ra = 2
Else
　R = 3: J = 5: S = 4: ga = 2: ra = 2
End if
とすることができます。

読込むデータは、練習2の住所録にあるのでVBAでBingo5_7からBookの開き方を参考にして、コーディングしてみてください。
繰り返す件数は、住所録に書かれている人数によります。前回までは、リストの最初の行から最終行までとして、たとえば For n=3 to LR などとしていましたが、今回はｎの値で行・列の値が決まることから、初期値を1としたいので１件目は３行目を、2件目は４行目を…n件目はn+2行目を処理することになります。
あとは、住所録の項目をラベルの対応するセルに代入すると完成します。
完成サンプルは、次のとおりです。

Sub ラベル()

    SN = Cells(8, "D")
    If SN = "シール1" Then
       R = 2: J = 7: S = 5: ga = 3: ra = 2
    Else
       R = 3: J = 5: S = 4: ga = 2: ra = 2
    End If

    Sheets(SN).Range("A:L") = ""

    DR = ThisWorkbook.Path
    Bn = DR & "¥練習2.xlsm"
    Workbooks.Open Bn
    Sheets("住所録").Select
 
    LR = Cells(Rows.Count, "B").End(xlUp).Row - 2  '最終行で件数を求める
    For n = 1 To LR

      行 = Fix((n - 1) / R) * J + ga
      列 = (n - Fix((n - 1) / R) * R - 1) * S + ra

      ThisWorkbook.Sheets(SN).Cells(行, 列) = "〒" & StrConv(Left(Cells(n + 2, "C"), 3) & "-" & Right(Cells(n + 2, "C"), 4), vbWide)  '〒
      ThisWorkbook.Sheets(SN).Cells(行 + 1, 列) = Cells(n + 2, "D") & Cells(n + 2, "E") '県・市町村
      ThisWorkbook.Sheets(SN).Cells(行 + 2, 列) = Cells(n + 2, "F") '番地
      ThisWorkbook.Sheets(SN).Cells(行 + 3, 列) = Cells(n + 2, "G") '方書
      ThisWorkbook.Sheets(SN).Cells(行 + 4, 列) = Cells(n + 2, "B") & "　様" '氏名

    Next n
    ActiveWorkbook.Close

End Sub

ここで、もう一工夫欲しいところです。
実際ラベルシールを作るうえで、真っ新なシートに出力するときは、これで良いのですが、たとえば21枚中8枚使用して13枚残っているとしましょう。このシートを無駄なく使うために9枚目から出力したい。などの思いを経験された方もいらっしゃるのではないでしょうか？
このモヤモヤを解消するために、一つの変数を追加しましょう。その変数名をi（アイ）として
行= Fix((n + i - 1) / R) * J + ga
列= (n + i - Fix((n + i - 1) / R) * R - 1) * S +ra
のように、算式を変更して実行ボタンが押されたとき、InputBoxでiの値を受け取るようにしましょう。
インプットボックスの使い方は
i = InputBox("文字列（メッセージ）", "文字列（タイトル）", 初期値)です。

実際のコーディング例は
i = InputBox("1枚目の出力位置を入力してください。", "出力位置調整", 1)
　If i = "" Or i < 1 Then Exit Sub
i = i - 1　となります。

Sheets(SN).Range("A:L") = ""の１行前に挿入してください。
ここで1引いているのは、1枚目の調整値が0のためiは0、同様に2枚目以降はi-1とるためです。

iを5として、シート2に出力すると

のように、5枚目から出力されます。

また、今回は１ページ分を作っていますが複数ページに対応したい場合は、２ページ目を出力するタイミングでi=0にすると良いですよ。
複数ページ対応にもチャレンジしてみてくださいね。

今回も最後までご覧いただき、ありがとうございました。

箸休め_6

いいなと思ったら応援しよう！