Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6708 / 13644 ツリー ←次へ | 前へ→

【43536】個票の作成マクロについて Non 06/10/18(水) 23:58 質問[未読]
【43542】Re:個票の作成マクロについて ichinose 06/10/19(木) 8:37 発言[未読]
【43619】Re:個票の作成マクロについて Non 06/10/20(金) 1:48 お礼[未読]
【43586】Re:個票の作成マクロについて Kein 06/10/19(木) 15:07 回答[未読]
【43618】Re:個票の作成マクロについて Non 06/10/20(金) 1:46 お礼[未読]

【43536】個票の作成マクロについて
質問  Non  - 06/10/18(水) 23:58 -

引用なし
パスワード
   はじめて質問します。Sheet1にある一覧表(成績一覧)からSheet2に個票を作成し、それを1ページに1枚ずつ(つまり一人分ずつ)印刷するマクロはよくネットにも掲載されているので分かるのですが、用紙の無駄をなくすため、1枚の用紙(A4)に3〜5名分の個票を作成する場合はどのように組んだらよいのでしょうか。よろしくお願いします。

【43542】Re:個票の作成マクロについて
発言  ichinose  - 06/10/19(木) 8:37 -

引用なし
パスワード
   ▼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ページ内に収まるようにページ設定されているという条件です。

試してみてください。

実際には、差し込むデータは氏名だけではないのでしょうね?
これをどのように改良していくかは考えてみてください。

【43586】Re:個票の作成マクロについて
回答  Kein  - 06/10/19(木) 15:07 -

引用なし
パスワード
   いちいち
>Sheet2に個票を作成
などしなくても、Sheet1をダイレクトに印刷したらどうですか ?
例えば1行目は項目であるとして、それを全てのページのタイトル行とし、
任意の人数分(3〜5に限定)の A:H列 にあるデータを印刷するとして・・

Sub MyPrint()
  Dim i As Long
  Dim Stp As Integer

  If WorksheetFunction.CountA(Range("A:A")) = 1 Then Exit Sub
  Do
   Stp = Application.InputBox("印刷するデータの人数を" & _
   vbLf & "3〜5の数値で入力して下さい", Type:=1)
   If Stp = False Then Exit Sub
  Loop While Stp < 3 Or Stp > 5
  With ActiveSheet.PageSetUp
   .PrintTitleRows = "$1:$1"
   .PaperSize = xlPaperA4
  End With
  On Error GoTo ELine
  For i = 2 To Range("A65536").End(xlUp).Row Step Stp
   Cells(i, 1).Resize(Stp, 8).PrintOut Copies:=1
  Next i
ELine:
End Sub

てな感じでどうかな・・?

【43618】Re:個票の作成マクロについて
お礼  Non  - 06/10/20(金) 1:46 -

引用なし
パスワード
   ▼Kein さん:
ありがとうございます。試してみます。

【43619】Re:個票の作成マクロについて
お礼  Non  - 06/10/20(金) 1:48 -

引用なし
パスワード
   ▼ichinose さん:
ありがとうございます。私には難しそうですが試してみます。

6708 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free