|
▼Non さん:
おはようございます。簡単なサンプルです。
新規ブックにのSheet1というシートに以下のような
印刷データを印刷用サンプルデータとして用意します。
Sheet1
A
1 氏名
2 あああ
3 いいい
4 ううう
5 えええ
6 おおお
7 かかか
8 ききき
このA2からA8のデータをSheet2の
A2、A20、A38の3データ毎にセットし、印刷を繰り返します。
標準モジュール(Module1)に
'==================================================
Sub main()
Dim sht As Worksheet
Dim rw As Long
Set sht = Worksheets("sheet2")
Call sashikomi_open(sht, Array(sht.Range("a2"), sht.Range("a20"), sht.Range("a38")))
'ここに印刷したいセルを配列にして指定する
'この例では、Sheet2のA2、A20、A38に設定し、印刷します
rw = 2
Do Until Cells(rw, 1).Value = ""
Call sashikomi_put(Cells(rw, 1).Value)
rw = rw + 1
Loop
Call sashikomi_close
End Sub
別の標準モジュール(Module2)に
'===================================================================
Option Explicit
Private sh_ptr As Long
Private sh_pr_array As Variant
Private sh_sht As Worksheet
'===================================================================
Sub sashikomi_open(sht As Worksheet, pr_array As Variant)
'差込印刷処理の初期化処理
'sht ----印刷対象ワークシート
'pr_array ---sht内の印刷するセルを含む配列
sh_ptr = 0
sh_pr_array = pr_array
Set sh_sht = sht
End Sub
'===================================================================
Sub sashikomi_put(pr_data As Variant)
' 指定されたデータを印刷対象シートに指し込む
If sh_ptr > UBound(sh_pr_array) Then
Call sh_print
sh_ptr = 0
End If
sh_pr_array(sh_ptr).Value = pr_data
sh_ptr = sh_ptr + 1
End Sub
'===================================================================
Sub sashikomi_close()
' 差込印刷処理の終了処理
If sh_ptr > 0 Then
Call sh_print
End If
sh_ptr = 0
Erase sh_pr_array
Set sh_sht = Nothing
End Sub
'===================================================================
Sub sh_print()
' 印刷対象シートの印刷及び、データの初期化
Dim idx As Long
sh_sht.PrintOut
For idx = LBound(sh_pr_array) To UBound(sh_pr_array)
sh_pr_array(idx).Value = ""
Next
End Sub
というコードです。
Sheet1のデータシートをアクティブにした状態で
mainを実行してみてください。
あああ
いいい
ううう
で1ページ印刷
えええ
おおお
かかか
で1ページ印刷
ききき
のみでで1ページ印刷
という処理になります。
尚、予めSheet2のA2、A20、A38は
1ページ内に収まるようにページ設定されているという条件です。
試してみてください。
実際には、差し込むデータは氏名だけではないのでしょうね?
これをどのように改良していくかは考えてみてください。
|
|