[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『連番入り複数印刷の差し込み印刷』（tam）
梱包用ラベルを作成するのにエクセルのみで差し込み印刷のようなものをマクロで出来ないかと考えています。
まず、入力シートのB列（B2以下）に印刷したいロット番号を入力します。
（複数の場合もあります。）
別ファイルの「リスト」から印刷したいデータを抽出して、D列より右にvlookupで
表示させています。
A列にナンバーリングの数字を入れてあります。
各ロット毎に印刷シートに表示したデータを当てはめて印刷したいのですが、
印刷シートは4分割して使う為、A21、Y21、A48、Y48セルに順番に連番が入ります。
印刷2枚目は5から始まり、印刷枚数(1/4分)分まで続きます。
この印刷数は入力シートのH列に入数、I列にその枚数が表示されています。
この辺がややこしいのですが、この枚数の数字は1/4分が何枚かという意味です。
また、合計数量が入数で割り切れない場合は、最後に端数の入数で1枚印刷する必要があります。この端数の入数と枚数はJ列、K列に表示されています。
これが1ロット分で、引き続きB3以降が自動で同じ動作でロット番号が入力されただけ
続くようにしたいのですが可能でしょうか？
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
文章でははっきり伝わりにくいので、端的にサンプルを追記したらどうですか？ 印刷したいラベルが6個とした例がいいでしょう。 入力シートのB列、H列〜K列を確認のために書いて下さい。
<<"入力"シート>>
A列 B列 C D E F G H列 I列 J K
1 連番
2 1
3 2
4 3
5 4
6 5
7 6
<<"印刷"シート>>
A列 Y列
21 1 2
48 3 4
できるかできないかだけ尋ねているんですか？ だったら、できますが回答ですが、まさかそれで終わりじゃないでしょう？
どこまでできていて、詰まっているのはどこですか？ できているところまでコードを示してください。
（γ） 2020/01/27(月) 09:09
>可能でしょうか？
ループを4行毎にしたらいいと思います。
dim 転記先セル as range
dim 転記元セル as range
set 転記元セル = worksheets("転記元").range("A2:" & cells(rows.count,"A").end(xlup).row)
set 転記先セル= worksheets("転記先").range("A21,Y21,A48,Y48")
for ixRow =1 to 最終行 step 4
転記先セル(1).value = 転記元(ixrow,1).value
転記先セル(2).value = 転記元(ixrow+1,1).value
転記先セル(3).value = 転記元(ixrow+2,1).value
転記先セル(4).value = 転記元(ixrow+3,1).value
転記先セル.worksheet.printpreview
next
割り切れない場合は、あんまり難しく考えないで、
「空白」を転記すればよくないですか？
ここに直接書いたのでタイプミス等があればご容赦ねがいます。
※ここはプログラムを作成依頼する場ではありません。
どんな風に課題に取り組んで、どこで躓いたか説明し、
わからないところを聞いて下さい。
可能ですか？という聞き方は漠然としすぎてます。
どう聞いていいか思いつかないという気持ちはわかりますが、
質問の仕方で損をするのは質問者だけなので、
以後気を付けていただけるとよい回答が比較的早く得られると思います。
（まっつわん） 2020/01/27(月) 09:15
<<"入力"シート>>
A列 B列 C D E F G H列 I列 J列 K列
1 No. 入力ロット番号 入数 枚数1 端数 枚数2
2 1 B000018051 3 5 0 0
3 2 B000018052 3 1 2 1
4 3 B000018053 2 7 0 0
5 4 B000018054 2 3 1 1
6 5 B000018055 2 5 1 1
7 6 B000018056 2 100 0 0
<<"印刷"シート>>
A列 Y列
21 1 2
48 3 4
例としてこんな感じですが、CからH列の内容も"印刷"シートに表示させる必要があり、
まずNo.1の連番付き印刷の処理を考えて、これのループでNo.2〜6を繰り返すというコードを考える必要があるのかなというイメージを持っている感じですが違いますでしょうか？
No.1だけでみると入り数3の5枚ですので、A4 2枚目の左上1枠に連番5で終わり
その他の3枠はC〜H列の値は表示させなくするつもりです。
マクロ自体あまり詳しい状態でなく、いろいろ調べながら勉強しているところです。
トライしてみたコード等出来ましたらまた書き込みはさせていただきます。
（まっつわん）さん
まだ内容が理解出来てないですが下記の転記元の宣言がないように思うのですが、転記元セルの間違いでしょうか？
＞ 転記先セル(1).value = 転記元(ixrow,1).value
（tam） 2020/01/27(月) 21:27
うーむ。これは確かに書いてもらって始めて理解が始まる （分かったと言うわけでも無い）という感じの内容ですね。
| 1 No. 入力ロット番号 入数 枚数1 端数 枚数2 | 2 1 B000018051 3 5 0 0 | 3 2 B000018052 3 1 2 1
私は「入り数」という流通関係の言葉を初めて見ました。 でもこれはラベルの印刷枚数とは直接関係しないですよね。
要するに、上の内容を平たく言うと、 No1のラベル を 5枚 No2のラベル を 2枚(=1+1) 作れ、ということなんですかね。
であれば、 No 必要ラベル数 1 5 2 2 3 7 4 4 ・・・・ というデータをもとに、最初に以下のデータに増幅してしまったほうが早いのでは？ 1 1 1 1 1 2 2 3 3 3 3 3 3 3 4 4 4 4
あとは、このデータと、まっつわんさんのコードを用いて、 4ラベルずつ印刷すればいいんじゃないですかね。 コードはそちらでトライしてみて下さい。 （γ） 2020/01/27(月) 22:14
入り数表記が印刷シートのE9、AC9、E36、AC36とありますが、ここに入れる関数式もちょっと難しくなりそうです。
ラベル枚数としては何100枚と印刷することもありますが増幅してできますでしょうか？
（tam） 2020/01/27(月) 23:27
A列 B列 C D E F G H列 1 No. 入力ロット番号 個数 入数 2 1 B000018051 15 3 3 2 B000018052 5 3 4 3 B000018053 13 5
↑の場合の1例
Option Explicit
Sub test()
Dim i As Long, j As Long, k As Long, n As Long
Dim Rng As Range
Dim r As Range
With Worksheets("Sheet2").Range("A1").CurrentRegion
Set Rng = Intersect(.Cells, .Offset(1))
End With
For Each r In Rng.Rows
k = r.Cells(6).Value
With Worksheets("Sheet3").Range("A21,Y21,A48,Y48")
For i = 1 To r.Cells(6).Value Step .Cells.Count
.ClearContents
For j = 1 To .Cells.Count
n = i + j - 1
If n > k Then Exit For
.Areas(j).Value = n
Next
.Worksheet.PrintPreview
Next
End With
Next
End Sub
＞かなというイメージを持っている感じですが違いますでしょうか？
＞転記元セルの間違いでしょうか？
そうかも知れないですし、そうでないかも知れないですけど、
いちいち確認しないといけないですか？
プログラムを書くのは自分なのですから、
自分が「こうしたい！」ということをコードに反映させればいいのでは？
真似できるところは真似して、なにか間違ってると思う箇所が
あれば変えてください。
あくまでもサンプルなので、参考程度に考えてください。
今からVBAを勉強していくなら、練習なのでどんどん書いて
どんどん失敗して覚えていきましょう。
その上で上手く行かない点などについて、
アドバイスを求めてみては？
（まっつわん） 2020/01/28(火) 10:13
参考コード例を作成してみました。 "ツール"という名前のシートを作成しておいてください。作業用に使用します。
入数 枚数1 端数 枚数2
3 5 2 2
というデータであれば、
1 3
2 3
3 3
4 3
5 3
6 2
7 2
のような入数、端数のデータを書き出します。（A列は連番のつもりでしたが、使っていません）
その後、上から4つづつラベルを作成することにしています。
Option Explicit
Dim wsData As Worksheet Dim wsPrint As Worksheet Dim wsTool As Worksheet Dim r1 As Range Dim r2 As Range Dim r As Range Dim rng1 As Areas Dim rng2 As Areas
Sub test()
Dim k As Long
Set wsData = Worksheets("入力")
Set wsPrint = Worksheets("印刷")
Set wsTool = Worksheets("ツール")
'連番
Set r1 = wsPrint.Range("A21")
Set r1 = Union(r1, r1.Offset(0, 24), r1.Offset(27, 0), r1.Offset(27, 24))
Set rng1 = r1.Areas
'入数、端数
Set r2 = wsPrint.Range("E9")
Set r2 = Union(r2, r2.Offset(0, 24), r2.Offset(27, 0), r2.Offset(27, 24))
Set rng2 = r2.Areas
Set r = Union(r1, r2)
'各No に関する処理を繰り返す
For k = 2 To wsData.Cells(Rows.count, "A").End(xlUp).Row
Call printLabel(k)
Next
End Sub
' No k についてのラベル作成処理を行う
Function printLabel(k As Long)
Dim 入数&, 枚数1&, 端数&, 枚数2& ' & は As Long と同等の効果（型宣言文字）
Dim n&, j&, p&, m&
Dim res&
入数 = wsData.Cells(k, "H").Value
枚数1 = wsData.Cells(k, "I").Value
端数 = wsData.Cells(k, "J").Value
枚数2 = wsData.Cells(k, "K").Value
'(1)準備：ツールシートに入数を枚数1個、端数を枚数2個 書き出す
wsTool.Columns("A:B").ClearContents
wsTool.Cells(1, "B").Resize(枚数1).Value = 入数
If 枚数2 > 0 Then
wsTool.Cells(枚数1 + 1, "B").Resize(枚数2).Value = 端数
End If
For p = 1 To 枚数1 + 枚数2
wsTool.Cells(p, "A").Value = p '連番
Next
'(2)印刷シートへの書き込みと印刷
n = Int((枚数1 + 枚数2) / 4)
res = (枚数1 + 枚数2) Mod 4
r.ClearContents
'(2-1)ラベル4枚の組みについて処理
If n > 0 Then
For m = 1 To n
For p = 1 To 4 'ラベル枚数の繰り返し
j = 4 * (m - 1) + p
' ここにデータのコピー処理(入力シート→印刷シート）を書く
rng1(p).Value = j '連番
rng2(p).Value = wsTool.Cells(j, "B").Value '入数、端数
Next
wsPrint.PrintPreview
Next
End If
'(2-2)残余部分（ラベルが4枚に満たないもの）の処理
If res > 0 Then
r.ClearContents
For p = 1 To res
j = 4 * n + p
' ここでデータのコピー処理
rng1(p).Value = j '連番
rng2(p).Value = wsTool.Cells(j, "B").Value '入数、端数
Next
wsPrint.PrintPreview
End If
End Function
なお、上記はあくまでも参考です。 これへの修正とか、機能追加について行う積もりはございません。 あなたのほうで、必要があれば、これに追加・修正（削除）をしてください。それでは。 （γ） 2020/01/28(火) 10:17
Sub ボタン8_Click()
Dim 番号As Integer
Dim i As Long, pn
For 番号 = 1 To Application.WorksheetFunction.Sum(Range("N2:N200"))
Worksheets("印刷").Range("A21").Value = 1
pn = Worksheets("入力").Range("N" & 番号).Value
For i = 1 To pn
Sheets("印刷").PrintPreview
Worksheets("印刷").Range("A21").Value = Worksheets("印刷").Range("A21").Value + 4
Next
Sheets("印刷").Range("X4").Value = 番号
Next 番号
End Sub
（tam） 2020/01/29(水) 03:20
>どちらも試してみましたが、まだまだ理解不足で動作が止まらなくなったり、 >うまくいかなかったので
「上手く行かない」では何がどうなったかさっぱりわからないです。
慣れた人でも、一発で完璧なプログラムを作るのは困難です。
むしろ、バグがあるのが普通です。
（マイクロソフトなどもしょっちゅう修正プログラムを配布してますよね？）
なので、どこに問題があるかを見つけて修正していく(=デバッグ）技術を身に付けることも肝要です。
ちょうどいい例題なので、そういうのもどうやっているか聞いてみるのもありかと思うのですが。。。
聞かないと教えてもらえないので。。。。
こちらがプログラムを作っているわけではないので、
とくにこちらは困りませんが、
「上手く行かない」と言われると、モヤモヤしますよね＾＾；
（まっつわん） 2020/01/29(水) 09:03
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.