Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : 指定なし)
別シートを同一シートに印刷したい
投稿日時: 22/04/27 12:00:50
投稿者: onioni

振替伝票をエクセルで入力・印刷できるようにしました。
色々なサイトを見て作成したのですが、追加で実装したい機能がありますので
お力を貸していただきたいです。
 
Excelに入力シートと雛形シートを作り、
入力シートに仕分けた科目を振替伝票作成ボタンを押すことで日付ごとに伝票をシートに出力するというとこまで実装しました。
 
コードは以下になります。

 d = Cells(Rows.Count, 2).End(xlUp).Row '入力シートの最終行を取得
  Dim sh As Variant '日時用変数

    With ActiveSheet
        .Range("A6").Sort key1:=.Range("B3"), order1:=xlAscending, Header:=xlYes '入力シートのデータを日付順に並び替え
    End With

    No = 1
    Worksheets("雛形").Copy after:=Worksheets("雛形") '最初の日付の振替伝票シート作成
    Worksheets("入力シート").Select
    sh = Split(Cells(7, 2), "/") '日付欄を年,月,日に分割し、変数shに代入(この時点で、変数shは配列変数になります)。
    Worksheets(3).Name = sh(1) & "." & sh(2) '配列変数shより月と日を抜き出し、シート名に代入
    Worksheets(3).Range("D2").Value = sh(1) & "月" & sh(2) & "日" '配列変数shより月と日を抜き出し、振替え伝票シートのD2セルに代入
    Worksheets("入力シート").Range("C7:G7").Copy Worksheets(3).Range("C7:G7") '最初の行を振替伝票シートにコピー
    Worksheets(3).Range("G2").Value = sh(1) & "-" & No '配列変数shより月を抜き出し、Noと組み合わせて、振替伝票シートのG2セルに発行番号を入力
    No = No + 1 '発行番号繰り上げ
    n2 = 8 'n2に8を代入(7行目は既に入力済みなので)
    For n = 8 To d '(入力シートの8行目からd行目(最終行)まで繰り返し処理
      Worksheets("入力シート").Select
      If Range("H" & n) <> 0 Then '日付順に並び替えたあと、H列で日付の変わり目を判定しています。
        Worksheets("雛形").Copy after:=Worksheets("雛形") '日付の変わり目であれば、新しい振替え伝票シートを作成
        Worksheets("入力シート").Select
        sh = Split(Cells(n, 2), "/")
        Worksheets(3).Name = sh(1) & "." & sh(2)
        Worksheets(3).Range("D2").Value = sh(1) & "月" & sh(2) & "日"
        Worksheets("入力シート").Range("C" & n & ":G" & n).Copy Worksheets(3).Range("C7:G7") '入力シートのn行を振替伝票シートの最初の行にコピー
        Worksheets(3).Range("G2").Value = sh(1) & "-" & No
        No = No + 1 '発行番号繰り上げ
        n2 = 8 'n2を8にリセット(新しい振替伝票シートを作ったので)
      Else
        Worksheets("入力シート").Range("C" & n & ":G" & n).Copy Worksheets(3).Range("C" & n2 & ":G" & n2) '入力シートのn行を振替伝票シートのn2行にコピー
        n2 = n2 + 1
      End If
    Next
End Sub

 
ここに、日付ごとに分かれているシートを2日ごとに同じ用紙で印刷できるようにしたいのですが
どこにどう記入すればいいか分からなくなりました・・・
 
例えば、現状であれば下記になるのを
 
シート1             
|――――――――――――――|  
|              |
| 振替伝票4/1分       |
|              |
|              |
|――――――――――――――|
      ・
      ・
      ・
    以下余白
 
シート2
|――――――――――――――|
|              |
| 振替伝票4/2分       |
|              |
|              |
|――――――――――――――|
      ・
      ・
      ・
    以下余白
 
シート1             
|――――――――――――――|  
|              |
| 振替伝票4/1分       |
|              |
|              |
|――――――――――――――|
   
 
|――――――――――――――|
|              |
| 振替伝票4/2分       |
|              |
|              |
|――――――――――――――|
      
 
このように1つのシートに2日分ほどまとめたいです。
     
こうすることで印刷用紙の削減につなげたいです。
 
こういうことは可能でしょうか?
支離滅裂で文章が分かりにくいかもしれませんがお力を貸していただきたいです。
 
よろしくお願いします。     
  
 
 

回答
投稿日時: 22/04/27 13:58:20
投稿者: mattuwan44

1つのシートにコピペしてから印刷してみては?

回答
投稿日時: 22/04/27 13:59:06
投稿者: simple

ご苦労さまです。
 
コードには改善余地があります。(まあ、誰にもあるわけですけど)
最大の問題は、シートを指定しないセル範囲指定を使っている点ですね。
 
セルを選択しているからと、シート名を省略して範囲指定すると、
いま何がアクティブかを、読み手(将来のあなた)が気を使いながら読まないといけない、
分かりにくい、という点です。
 
ま、それはさておき、確認です。
(1)二日単位ということでいいんですね。
   >2日分ほどまとめたいです。
   と曖昧ですが。
(2)発行番号の付与ルールはどうなるんですか?
   従前と同じですか?
(3)発行番号とか、日付とはどの位置にどう表示するのか、
   変更後のレイアウトを明確にすべきではないですか?

回答
投稿日時: 22/04/27 14:14:17
投稿者: simple

ああ、そういうことですか。
別に今のシート体系は基本的には変えるという積りは無く、単に印刷の問題だけなら、
コピーペイストでしょうね。

回答
投稿日時: 22/04/27 15:50:23
投稿者: Suzu

シートオブジェクトとして 残さなくても良いなら、
 
・Word と連携し 差し込み印刷
 
・Word を使わず、差し込み印刷 の様になる様
  1)VBA を使い 原紙に それらの日の 値を代入 2日分いれたら 印刷 を繰り返す
  2)VBA を使わずに、印刷シートの特定セルに 入れた値 を参照し
       INDIRECT や、 INDEX・MATCH を使い、入力シート のデータを表示させる
 
とか。

回答
投稿日時: 22/04/27 17:55:37
投稿者: よろずや

用紙設定をA5横にし、プリンタのプロパティでA4縦の2ページ割り付けにすればよろしいかと。

投稿日時: 22/04/28 11:50:11
投稿者: onioni

mattuwan44 さんの引用:
1つのシートにコピペしてから印刷してみては?

 
やはりそれが一番簡単な方法になるのでしょうか・・・?
シートが20シートぐらいあるのでそれを手作業でコピペするのは大変かなと思い
質問をさせて頂いたのですが印刷だけだったらコードを作らなくてもよいのかもしれませんね・・・
 
回答ありがとうございました。

投稿日時: 22/04/28 11:52:44
投稿者: onioni

simple さんの引用:
ああ、そういうことですか。
別に今のシート体系は基本的には変えるという積りは無く、単に印刷の問題だけなら、
コピーペイストでしょうね。

 
simple様
 
ご回答ありがとうございます。
 
やはり印刷だけとなるとコピペしか方法はないのですね・・・
20シートほどあるのでそれを手作業でコピペは大変かと思い質問を致しました。。
 
色々と考えて頂きありがとうございます。

投稿日時: 22/04/28 11:53:50
投稿者: onioni

Suzu さんの引用:
シートオブジェクトとして 残さなくても良いなら、
 
・Word と連携し 差し込み印刷
 
・Word を使わず、差し込み印刷 の様になる様
  1)VBA を使い 原紙に それらの日の 値を代入 2日分いれたら 印刷 を繰り返す
  2)VBA を使わずに、印刷シートの特定セルに 入れた値 を参照し
       INDIRECT や、 INDEX・MATCH を使い、入力シート のデータを表示させる
 
とか。

 
suzu様
 
ご回答ありがとうございます。
 
・Word と連携し 差し込み印刷
 
こちらは検討してみたいと思います!
 
ありがとうございました。

投稿日時: 22/04/28 11:55:43
投稿者: onioni

よろずや さんの引用:
用紙設定をA5横にし、プリンタのプロパティでA4縦の2ページ割り付けにすればよろしいかと。

 
よろずや様
 
ご回答ありがとうございます。
 
割付印刷がいちばん簡単だと思い試したのですが
なぜか私のエクセルでは割付(当方の印刷設定は2in1)が反映されません(-_-;)
 
割付ができるのであればそちらをしたいのですがなぜ反映されないのか・・・

回答
投稿日時: 22/04/28 13:34:24
投稿者: よろずや

onioni さんの引用:
よろずや さんの引用:
用紙設定をA5横にし、プリンタのプロパティでA4縦の2ページ割り付けにすればよろしいかと。

割付印刷がいちばん簡単だと思い試したのですが
なぜか私のエクセルでは割付(当方の印刷設定は2in1)が反映されません(-_-;)

余白の設定で変わりませんか?
A5横の余白を大きめにするか、A4の2in1の余白を小さくするか...

回答
投稿日時: 22/04/30 18:01:22
投稿者: simple

4/27に、コードの書き方についてコメントしました。
私でしたらこんな風に書くかな、という実例を参考までに示します。
 

Option Explicit
Dim ws入力 As Worksheet, ws雛形 As Worksheet, ws振替 As Worksheet
Sub test()
    Dim lastRow As Long
    Dim No      As Long
    Dim r       As Long
    Dim row2    As Long
    
    Set ws入力 = Worksheets("入力シート")
    
    lastRow = ws入力.Cells(Rows.Count, "B").End(xlUp).Row
    ws入力.Range("A6").Sort key1:=ws入力.Range("B6"), _
                            order1:=xlAscending, Header:=xlYes

    No = 1
    Call 振替シート新規作成(7, No)

    No = No + 1         '  発行番号繰り上げ
    row2 = 8            ' 7行目までは既に入力済みなので
    
    For r = 8 To lastRow    '入力シートの8行目から最終行まで
        If ws入力.Cells(r, "H") <> 0 Then   'H列で日付の変わり目を判定
            '日付の変わり目であれば、新しい振替え伝票シートを作成
            Call 振替シート新規作成(r, No)
            No = No + 1     '発行番号
            row2 = 8        '転記先位置
        Else
            '入力シートから振替伝票シートへコピー
            ws入力.Cells(r, "C").Resize(1, 5).Copy ws振替.Cells(row2, "C")
            row2 = row2 + 1
        End If
    Next
End Sub

Function 振替シート新規作成(日付シート行番号 As Long, 月毎番号 As Long)
    Dim ymdAry As Variant
    Dim month As Long, day As Long

    Worksheets("雛形").Copy after:=Worksheets("雛形")
    Set ws振替 = ActiveSheet
    With ws振替
        ymdAry = Split(ws入力.Cells(日付シート行番号, "B"), "/") '年,月,日に分割
        month = ymdAry(1): day = ymdAry(2)
        .Name = month & "." & day
        .Range("D2").Value = month & "月" & day & "日"

        ws入力.Cells(日付シート行番号, "C").Resize(1, 5).Copy .Cells(7, "C")
        .Range("G2").Value = month & "-" & 月毎番号     '月毎発行番号
    End With
End Function

また、変更後のレイアウト(一日のデータの最大領域、発行番号などの位置)を
もう少し詳しく提示してもらうとよいかもしれません。

トピックに返信