[[20190530105154]]　『複数シートへ日付を入れて交互に印刷』（もち）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『複数シートへ日付を入れて交互に印刷』（もち）

シート1に印刷フォームを入れ、指定した日付からn日分の印刷を行っています。

印刷対象ははシート2及びシート3です。

            '一括印刷
            Case "○印のついているもの全て"
                For j = 4 To 24
                    '○印のものだけ印刷
                    If Worksheets("日報印刷").Cells(j, 5) = "○" Then
                        temp = Worksheets("日報印刷").Cells(j, 2)
                        縦 = Val(Worksheets("日報印刷").Cells(j, 3))
                        横 = Val(Worksheets("日報印刷").Cells(j, 4))
                        Worksheets(temp).Activate
                        For i = 1 To 枚
                            Cells(縦, 横) = DateSerial(年, 月, 日) + i - 1
                            ActiveWindow.SelectedSheets.PrintOut Copies:=1

これで、仮に1/1から2日分で印刷をかけますと、

　シート2　1/1
　シート2　1/2
　シート3　1/1
　シート3　1/2

上記のように出力されます。

　シート2　1/1
　シート3　1/1
　シート2　1/2
　シート3　1/2

のように出力させるにはどうすればよろしいでしょうか。
ご教示願います。

＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞

---

もうちょっと全体が見えないと、私にはどんな状況なのか分かりませんけど
シート2の１ページ目、シート３の１ページ目、シート2の２ページ目、シート３の２ページ目　というような順番で印刷したいということなら

    Sub test()
        Dim i As Long
        Dim MySH As Worksheet

        For i = 1 To 2
            For Each MySH In Worksheets(Array("シート２", "シート３"))
                MySH.PrintOut From:=i, To:=i
            Next
        Next

    End Sub

このような感じではどうでしょうか？

（もこな２） 2019/05/30(木) 12:38

---

ご回答ありがとうございます。
確かに全体が分からないと答えようがないですよね、、申し訳ありません。

Private Sub UserForm_Initialize()

'コンボボックスの設定

    With ComboBox1
        .AddItem ("○印のついているもの全て")
        .AddItem (Worksheets("日報印刷").Range("B4"))
        .AddItem (Worksheets("日報印刷").Range("B5"))
        .AddItem (Worksheets("日報印刷").Range("B6"))
        .AddItem (Worksheets("日報印刷").Range("B7"))
        .AddItem (Worksheets("日報印刷").Range("B8"))
        .AddItem (Worksheets("日報印刷").Range("B9"))
        .AddItem (Worksheets("日報印刷").Range("B10"))
        .AddItem (Worksheets("日報印刷").Range("B11"))
        .AddItem (Worksheets("日報印刷").Range("B12"))
        .AddItem (Worksheets("日報印刷").Range("B13"))
        .AddItem (Worksheets("日報印刷").Range("B14"))
        .AddItem (Worksheets("日報印刷").Range("B15"))
        .AddItem (Worksheets("日報印刷").Range("B16"))
        .AddItem (Worksheets("日報印刷").Range("B17"))
        .AddItem (Worksheets("日報印刷").Range("B18"))
        .AddItem (Worksheets("日報印刷").Range("B19"))
        .AddItem (Worksheets("日報印刷").Range("B20"))
        .AddItem (Worksheets("日報印刷").Range("B21"))
        .AddItem (Worksheets("日報印刷").Range("B22"))
        .AddItem (Worksheets("日報印刷").Range("B23"))
        .AddItem (Worksheets("日報印刷").Range("B24"))
    End With

End Sub

Private Sub 終了_Click()

    Unload 入力画面
    End
End Sub

Private Sub 入力OK_Click()

'データを変数に代入

    年 = 入力画面.TextBox1.Value
    月 = 入力画面.TextBox2.Value
    日 = 入力画面.TextBox3.Value
    枚 = 入力画面.TextBox4.Value
    シート = 入力画面.ComboBox1.Value
'データを文字列から数値に変換
    年 = Val(年)
    月 = Val(月)
    日 = Val(日)
    枚 = Val(枚)

'不正なデータをチェック

    If 年 < 1900 Or 年 > 2020 Then
        dummy = MsgBox("年データが不正です　　", vbExclamation)
        入力画面.TextBox1.SetFocus
        Exit Sub
    End If
    If 月 < 1 Or 月 > 12 Then
        dummy = MsgBox("月データが不正です　　", vbExclamation)
        入力画面.TextBox2.SetFocus
        Exit Sub
    End If
    If 日 < 1 Or 日 > 31 Then
        dummy = MsgBox("日データが不正です　　", vbExclamation)
        入力画面.TextBox3.SetFocus
        Exit Sub
    End If
    If 枚 < 1 Or 枚 > 31 Then
        dummy = MsgBox("枚データが不正です　　", vbExclamation)
        入力画面.TextBox4.SetFocus
        Exit Sub
    End If

'シートデータチェック

    Select Case シート
        Case "予備"
            dummy = MsgBox("シートを選択してください　　", vbExclamation)
            入力画面.ComboBox1.SetFocus
            Exit Sub
        Case "○印のついているもの全て"
        Case Worksheets("日報印刷").Range("B4")
        Case Worksheets("日報印刷").Range("B5")
        Case Worksheets("日報印刷").Range("B6")
        Case Worksheets("日報印刷").Range("B7")
        Case Worksheets("日報印刷").Range("B8")
        Case Worksheets("日報印刷").Range("B9")
        Case Worksheets("日報印刷").Range("B10")
        Case Worksheets("日報印刷").Range("B11")
        Case Worksheets("日報印刷").Range("B12")
        Case Worksheets("日報印刷").Range("B13")
        Case Worksheets("日報印刷").Range("B14")
        Case Worksheets("日報印刷").Range("B15")
        Case Worksheets("日報印刷").Range("B16")
        Case Worksheets("日報印刷").Range("B17")
        Case Worksheets("日報印刷").Range("B18")
        Case Worksheets("日報印刷").Range("B19")
        Case Worksheets("日報印刷").Range("B20")
        Case Worksheets("日報印刷").Range("B21")
        Case Worksheets("日報印刷").Range("B22")
        Case Worksheets("日報印刷").Range("B23")
        Case Worksheets("日報印刷").Range("B24")
        Case Else
            dummy = MsgBox("シートを選択してください　　", vbExclamation)
            入力画面.ComboBox1.SetFocus
            Exit Sub
    End Select
'印刷確認
    Unload 入力画面
    printok = MsgBox(年 & "年　" & 月 & "月　" & 日 & "日から　" & 枚 & "日分" & Chr(13) & シート & "　を印刷しますか　　", vbYesNo + vbQuestion, "印刷")
    If printok = vbYes Then
    '印刷処理
        '印刷方法場合分け
        Select Case シート
            '一括印刷
            Case "○印のついているもの全て"
                For j = 4 To 24
                    '○印のものだけ印刷
                    If Worksheets("日報印刷").Cells(j, 5) = "○" Then
                        temp = Worksheets("日報印刷").Cells(j, 2)
                        縦 = Val(Worksheets("日報印刷").Cells(j, 3))
                        横 = Val(Worksheets("日報印刷").Cells(j, 4))
                        Worksheets(temp).Activate
                        For i = 1 To 枚
                            Cells(縦, 横) = DateSerial(年, 月, 日) + i - 1
                            ActiveWindow.SelectedSheets.PrintOut Copies:=1
                        Next
                    End If
                Next
            '指定印刷
            Case Else
                For j = 4 To 24
                    '指定したシートだけ印刷
                    If Worksheets("日報印刷").Cells(j, 2) = シート Then
                        縦 = Val(Worksheets("日報印刷").Cells(j, 3))
                        横 = Val(Worksheets("日報印刷").Cells(j, 4))
                        Worksheets(シート).Activate
                        For i = 1 To 枚
                            Cells(縦, 横) = DateSerial(年, 月, 日) + i - 1
                            ActiveWindow.SelectedSheets.PrintOut Copies:=1
                        Next
                    End If
                Next
        End Select
    Else
    'キャンセル時は印刷しない
        End
    End If
    '日報画面に戻す
    Worksheets("日報印刷").Activate
End Sub

上記のように入れております。
よろしくお願いします。

（もち） 2019/05/31(金) 15:24

---

質問とは関係ない部分で気になったこと。

(1)
全体的に変数の宣言がない様に見られます。
つまらないミスでエラーになることもありますから、宣言を強制するようにしておいたほうが良いとおもいます。
http://officetanaka.net/excel/vba/beginner/06.htm

(2)
Val関数を多用してますが、理由はなんでしょうか？
「2019【年】」のように数字じゃないものまでTextBoxに入力してもらう設計なのでしょうか？

(3)
'コンボボックスの設定　について
少なくともループ処理を学んでみるともうちょっと短くなりそうです
http://officetanaka.net/excel/vba/tips/tips137.htm

    Private Sub UserForm_Initialize()
        Dim i As Long

        'コンボボックスの設定
        With ComboBox1
            .AddItem ("○印のついているもの全て")

            For i = 4 To 24
                .AddItem Worksheets(1).Range("B" & i)
            Next i
        End With

    End Sub

(4)
順番が前後しますが、コンボボックスの設定部分で、

 .AddItem (Worksheets("日報印刷").Range("B4"))

とされていますが、括弧いらないような気がします。
同じ理由で「シートデータチェック」のdummy = MsgBox(〜〜〜)も要らない括弧がついてます
http://officetanaka.net/excel/vba/beginner/07.htm

(5)
'シートデータチェック　について
ずらずら書いてますけど、結局、
・入力画面.ComboBox1で「予備」が選択されている状態のとき
・入力画面.ComboBox1でなにも選択されてない時
の２パターンしか処理することがないですよね。

それなら、2パターン分の処理だけすればよいとおもいます。
※テスト用に【CommandButton1】を追加しています。
http://officetanaka.net/excel/vba/tips/tips143.htm

    Private Sub CommandButton1_Click()
        'シートデータチェック
        With Me.ComboBox1
            If .Text = "予備" Then
                MsgBox "シートを選択してください", vbExclamation
                .SetFocus
                Exit Sub
            End If

            If .ListIndex = -1 Then
                MsgBox "シートを選択してください", vbExclamation
                .SetFocus
            End If
        End With
    End Sub

やりたいことは、メッセージボックスで同じメッセージを表示したいだけのようですから、もっとシンプルに

    Private Sub CommandButton1_Click()
        'シートデータチェック
        With Me.ComboBox1
            If .Text = "予備" Or .ListIndex = -1 Then
                MsgBox "シートを選択してください", vbExclamation
                .SetFocus
                Exit Sub
            End If
        End With
    End Sub

でよいかもしれません。

(6)
・DateSerial(年, 月, 日)
↑のようにするなら、もともと１つのテキストボックスだけに日付型を入力させるようにして
入力値が日付型であるのかどうかをチェックするほうがシンプルではないでしょうか？

    Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        With Me.TextBox1
            If .Value = "" Then Exit Sub

            If Not IsDate(.Value) Then
                MsgBox "入力値を日付としてみなせません"
                Cancel = True
            Else
                MsgBox Format(CDate(.Value), "yyyy月m月d日") & " が入力されました"
            End If

        End With
    End Sub

そして、肝心の質問の部分については、提示されたコードでもやりたいことがよくわかりませんでしたが、"○印のついているもの全て"が選択されているときは、

 (1)○のついたシートを巡回して１ページ目を印刷
 (2)○のついたシートを巡回して２ページ目を印刷

というように処理したいということではないでしょうか？
そうであるなら、↑のままの処理を書いてみてください。

 ※シート（名）を指定して、特定ページのみ印刷するヒントはすでに投稿したと思います。

なお、話が重複しますが、変数「縦」、変数「横」に数値以外が入る可能性があるんですか？

 （Val関数で数値に直す理由があるのか分からないので確認しています）

（もこな２） 2019/06/01(土) 11:05

---

書き忘れ。

 Private Sub 終了_Click() 
    Unload 入力画面
    End
 End Sub

↑でEndステートメントはどういった意味で書いているのですか？

「入力画面」以外にもユーザーフォームが開いていて、そちらも閉じたいのかな？とも推測しましたけど、Endステートメントで全部やめちゃうというのもちょっと乱暴かなと思い気になりました。
本当に、設計として提示されたような仕組みにするなら、

 Private Sub 終了_Click() 
    End
 End Sub

でよいということになりますが・・・

（もこな２） 2019/06/01(土) 11:16

---

追加で。
コンボボックスの設定部分について、もっと良い方法があるかもですがこのような方法も考えられます。

    Private Sub UserForm_Initialize()
        Dim MyArr() As String
        Dim i As Long

        'コンボボックスの設定
        With Worksheets("日報印刷").Range("B4:B24")
            ReDim MyArr(.Rows.Count)

            MyArr(0) = "○印のついているもの全て"
            For i = 1 To .Rows.Count
                MyArr(i) = .Cells(i)
            Next i
        End With

        ComboBox1.List = MyArr

    End Sub

また、"○印のついているもの全て"が先頭でなく末尾でよいということであれば

    Private Sub UserForm_Initialize()
        'コンボボックスの設定
        With Me.ComboBox1
            .List = Worksheets("日報印刷").Range("B4:B24").Value
            .AddItem "○印のついているもの全て"
        End With
    End Sub

とシンプルに考えてもよいかもしれません。

（もこな２） 2019/06/01(土) 11:49

---

コメント返信：

---

[ 一覧(最新更新順) ]

---

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.