| |
▼Non さん：
おはようございます。簡単なサンプルです。
新規ブックにのSheet1というシートに以下のような
印刷データを印刷用サンプルデータとして用意します。
Sheet1
Ａ
１ 氏名
２ あああ
３ いいい
４ ううう
５ えええ
６ おおお
７ かかか
８ ききき
このＡ２からＡ８のデータをSheet2の
Ａ２、Ａ２０、Ａ３８の３データ毎にセットし、印刷を繰り返します。
標準モジュール(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のＡ２、Ａ２０、Ａ３８に設定し、印刷します
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を実行してみてください。
あああ
いいい
ううう
で１ページ印刷
えええ
おおお
かかか
で１ページ印刷
ききき
のみでで１ページ印刷
という処理になります。
尚、予めSheet2のＡ２、Ａ２０、Ａ３８は
１ページ内に収まるようにページ設定されているという条件です。
試してみてください。
実際には、差し込むデータは氏名だけではないのでしょうね？
これをどのように改良していくかは考えてみてください。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
