Ｅｘｃｅｌでのラベル印刷

質問

ＥＸＣＥＬに入力されている顧客情報からＷＯＲＤの差し込み印刷機能を利用してラベルを作成したのですが、使用する人達がパソコンをあまり使い慣れていない人達なので、出来ればＥＸＣＥＬからボタンひとつで作成出来るようにしたいと考えています。
その時に、１件をラベルすべてに印刷したり、ラベルの位置（何行目何列）を指定したり出来るといいという事なのですが、こういう事は可能でしょうか？
ＶＢＡ、マクロを使用して出来るのであればそれでもよろしいのでお願いします。

回答No.1

imogasi · ベストアンサー

過去のＯＫＷＥＢ照会で同様内容らしきものを挙げます。Ｎ０．４３９６７０、ＮＯ．３８９５１１、ＮＯ．３７５３６８，ＮＯ．３１５３８５、ＮＯ．１６５８１３
最後のものには、荒っぽいですが、ＶＢＡコーディングのあらすじらしきものも小生が載せています。一度ご覧になってください。
もっと（１）エクセルで印刷位置のコントロールが出来る
とか（２）ＷｏｒｄＶＢＡでワードの差込み印刷まで含めてコントロールできる技量があれば、完全なコーディング解答になるのですが、自分が残念です。
（１）ラベルの種類（Ａ４，Ｂ５）（２列・３列）
　　　上・下・左・右余白、１枚の縦横ｃｍ
（２）エクセル表の行を指定するＩＤ項目（有・無）
（３）ラベルに印刷する項目・配置
（４）ワークシートの項目概要、行数（レコード数）概数
を補足していただければ、より具体的にコード見本を
作れるかもしれません。

補足

早速のお返事ありがとうございました。

（１）ラベルの種類（Ａ４）（２列５行）
余白→上（０．２）、下（０．４）、左（０．２５）、右（０．５）。
１枚の縦横→縦（７．８）、横（４．６）
（２）エクセル表の行を指定するＩＤ項目（無）
（３）ラベルに印刷する項目・配置
郵便番号
住所１
　住所２
（１行あける）
支払先名
　所属
（１行あける）
　窓口
　　　　　　　　　　　（コード）

（４）ワークシートの項目概要
コード、仕入先名、棚番、住所１、住所２、電話番号、窓口、ＦＡＸ、郵便番号
行数（レコード数）→１５０件（これからも増えます）

という事でよろしいでしょうか？

回答No.3

imogasi

(その１）
補足を頂いて後、日数もたちますので、一応の解答を入れます。バグ（誤り）やお気に召さない点があると思いますが、ご容赦願います。一応１００件以上でテストして、
印字は確認しました。ただ位置合わせは難しいと思いますが、列幅・行高の伸縮で上手くラベル内に納めるようテストプリントを繰り返してください。
（１）列の構成
(A)出状サイン(B)コード(c)仕入先(D)棚番(E)住所１(F)住所２(G)電話番号（H)所属（I)窓口（J)ＦＡＸ番号（K)郵便番号
出状サインは現状ないかもしれませんが、列挿入で１列作ってください。
＜ＯＫＷＥＢの１回当たりの文字制限があるようで、以下は（その２）に続きます＞
プログラムは、ある行が横に長いと、ＯＫＷＥＢで次行に
強制改行されるところが、発生します。そこは上の行の
右に次行をくっ付けて、作りなおして・修正してください。そうしないとエラーになります。

補足

回答ありがとうございました。
早速ためしてみたところ、
sh2.Range(Cells(1, "a"), Cells(60, "k")).ClearContents
の位置で’実行時エラー１００４’になってしまいました。
よろしくお願いします。

回答No.2

imogasi

（その２）
そしてラベルを作成する先（行）のＡ列に「１」を入れて、本プログラムを実行してください。
（２）テストプリント用紙
ラベル用紙（本物）のシールの切れ目（ミシン線？）のところを鉛筆と定規で線を引いて下さい。
そして複写機で２０枚ほど複写を取り、そのコピーした紙をプリンタにセットしてしてください。
（３）まずテストプリント「内容」項目・配置のチェック
テストプリンとして、シールに収まるか位置合わせは別にして、内容的に我慢できるかどうかチェックすること。結果を報告してください。
フォントのサイズもチェックしてください。
（３）位置合わせチェック・横幅
ラベルの１０枚のシールに横２列に収まるかどうか、Sheet2のA列とG列が遊びとして何も印刷していないので、列幅を伸縮させて調節してください。
フォントのサイズも影響すると思います。
（４）位置合わせチェック・縦巾
ラベルの１０枚のシールに縦５個に収まるかどうか、ミシン線を越えていないか、Sheet2の１列と　列が遊びとして何も印刷していないので、行高を伸縮させて調節してください。
フォントのサイズも影響すると思います。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1") '出状先データ（住所録
Set sh2 = Worksheets("sheet2") 'ラベルのフォーマット
sh1.Activate
d = sh1.Range("b2").CurrentRegion.Rows.Count
' MsgBox d
sh2.Activate
sh2.Range(Cells(1, "a"), Cells(60, "k")).ClearContents
sh1.Activate
hidari = "y"
For i = 2 To d
'---Ａ列だブランクの行は処理せず
If sh1.Cells(i, 1) <> "1" Then GoTo p01
n = n + 1
'--------ラベル左側
If hidari = "y" Then
sh2.Cells(lblgyo + 1, "b") = sh1.Cells(i, "k") '郵便番号
sh2.Cells(lblgyo + 2, "b") = sh1.Cells(i, "e") '住所１
sh2.Cells(lblgyo + 3, "b") = sh1.Cells(i, "f") '住所２
sh2.Cells(lblgyo + 5, "b") = sh1.Cells(i, "c") & "御中" '仕入先
sh2.Cells(lblgyo + 6, "b") = sh1.Cells(i, "h") & "様" '所属
sh2.Cells(lblgyo + 8, "b") = sh1.Cells(i, "i") '窓口
sh2.Cells(lblgyo + 8, "e") = sh1.Cells(i, "b") 'コード
hidari = "n"
Else
'--------ラベル右側
rightrtn:
sh2.Cells(lblgyo + 1, "h") = sh1.Cells(i, "k") '郵便番号
sh2.Cells(lblgyo + 2, "h") = sh1.Cells(i, "e") '住所１
sh2.Cells(lblgyo + 3, "h") = sh1.Cells(i, "f") '住所２
sh2.Cells(lblgyo + 5, "h") = sh1.Cells(i, "c") & "御中" '仕入先
sh2.Cells(lblgyo + 6, "h") = sh1.Cells(i, "h") '所属
sh2.Cells(lblgyo + 8, "h") = sh1.Cells(i, "i") & "様" '窓口
sh2.Cells(lblgyo + 8, "j") = sh1.Cells(i, "b") 'コード
hidari = "y"
lblgyo = lblgyo + 10
If lblgyo > 44 Then
prtrtn '印刷
sh2.Activate
sh2.Range(Cells(1, "a"), Cells(60, "k")).Clear
sh1.Activate
lblgyo = 1
End If
End If
p01:
Next i
prtrtn '印刷
MsgBox n
End Sub
Sub prtrtn()
With Worksheets("sheet2").PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(9.84251968503937E-02)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.078740157480315)
.BottomMargin = Application.InchesToPoints(0.15748031496063)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
Worksheets("sheet2").Range("a1:j50").PrintOut Copies:=1, Collate:=True
End Sub