| |
ＰＯＮ さん、おはようございます。
>＊１枚に印刷できるデータは４件です。
>＊「印刷用データ」に抽出されて出てきたデータが４件以上になった場合も、様式を初期化(空白)にして続けて差し込み印刷したいです。
>「印刷用データ」には↓のようにデータが入っています。A列の番号は連続していません。
> A B C D E
>1] 番号 名前 日付 用務 時間
>2] 3 あ い う え
>3] 5 か き く け
>4] 6 さ し す せ
>5] 9 た ち つ て
>
>差し込み印刷したい様式は↓でA11、A19、A27、A35に印刷用データのA列の番号が入れば他の項目はVLOOKUP関数で表示されるようになっています。
Ａ列のセルの値は不連続でも行番号は連続のようですので、４つ飛ばすごとに印刷するようにしました。
Sub test()
Dim ws(1 To 2) As Worksheet, RR&, Rpos&, NN&
'このマクロのブックが対象です
With ThisWorkbook
Set ws(1) = .Worksheets("Sheet1") 'リストのシートをセット
Set ws(2) = .Worksheets("Sheet2") '印刷するシートをセット
End With
'
'最下行計算(そこまでは連続で入ってるとして処理します)
With ws(1)
Rmax = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For RR& = 2 To Rmax
NN& = (RR& - 2) Mod 4 + 1 '1,2,3,4
'11,19,27,35 →3に8ずつ足していけばいい
ws(2).Cells(NN& * 8 + 3, "A").Value = ws(1).Cells(RR&, "A").Value
If NN& = 4 Or RR& = Rmax Then
If NN& < 4 Then
'最下行の場合は入っていないセルがあればクリアして印刷
For II& = NN& + 1 To 4
ws(2).Cells(II& * 8 + 3, "A").ClearContents
Next
End If
Application.Calculate '念のため再計算
ws(2).PrintOut from:=1, To:=1, copies:=1 '印刷
End If
Next
'終了
Erase ws
End Sub
こんな感じです。
|
|
りん
- 08/5/23(金) 4:38 -
