[[20210324111343]]　『チェックボタンが選択された範囲を印刷』（ETE）　ページの最後に飛ぶ

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

　

『チェックボタンが選択された範囲を印刷』（ETE）

ユーザーフォーム1にチェックボックスが４つあります。コマンドボタンを押すと
チェックボックスが何も選択されなかったら"選択されていません"とメッセージを出し1つ以上チェックボックスが選択されたら範囲全て印刷したいです。
調べながらコードを作ってみましたが、チェックボックスを一つ以上選択しても、"選択されていません"と出てしまいます。
また、チェックボックスチェックで範囲は設定してみましたがそれを印刷するコードをどうしたらいいかわかりません。できればプレビュー画面をだしたいのですが調べてもわかりませんでした。
どうすればいいのでしょうか？

Private Sub CommandButton1_Click()
Dim r As Range
Dim Result As Long
Dim MyStr As String
Dim i As Long 

     If CheckBox1 = True Then
     Worksheets("Sheet1").PageSetup.PrintArea = "B3:E13"


     If CheckBox2 = True Then
     Worksheets("Sheet1").PageSetup.PrintArea = "B15:E25"


     If CheckBox3 = True Then
     Worksheets("Sheet1").PageSetup.PrintArea = "B27:E37"


     If CheckBox4 = True Then
     Worksheets("Sheet1").PageSetup.PrintArea = "B39:E49"
    End If
    End If
    End If
    End If

'印刷範囲を設定 

  With ActiveSheet


    For i = 1 To 4
    If Me.Controls("Checkbox" & i) = False Then
     MsgBox "選択されていません"
    i = i + 1
    ElseIf Me.Controls("Checkbox" & i) = True >= 1 Then


    If Result = vbYes Then


        'Yesを選択され場合の処理


     ElseMyStr = "印刷しますか？"


    If Me.Controls("Checkbox" & i) = True > 1 Then


    Me.Controls("Checkbox" & i).PrintObject = Me.Controls("Checkbox" & i).Value


    Result = MsgBox(MyStr, vbYesNo + vbExclamation)
    Else
    'Noを選択された場合の処理
        Exit Sub
    End If


    End If
   End If
  Next


    End With

End Sub

＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞

今はどれか一つでもチェックの外れたボックスがあるとメッセージが出るようになっていますね。
Forで回すのではなく「すべてのチェックボックスのうちどれか一つでもTrueがあれば」という一つの式に変更することをおすすめします。
（きまぐれおじさん） 2021/03/24(水) 11:37
いろいろあるのでひとつずついきます。
次はこれです。わかりやすくするためインデントをつけました｡ 

    If CheckBox1 = True Then
        Worksheets("Sheet1").PageSetup.PrintArea = "B3:E13"
        If CheckBox2 = True Then
            Worksheets("Sheet1").PageSetup.PrintArea = "B15:E25"
            If CheckBox3 = True Then
                Worksheets("Sheet1").PageSetup.PrintArea = "B27:E37"
                If CheckBox4 = True Then
                    Worksheets("Sheet1").PageSetup.PrintArea = "B39:E49"
                End If
            End If
        End If
    End If

チェックボックス1のチェックが入っていないとチェック2以降の判定はしません。
また、チェック2以降のチェックが入っていると印刷範囲を追加するのではなく上書きします。
つまり、チェック4まですべて入っていると、設定される印刷範囲は"B39:E49"だけです。
これで正しければ良いのですが、もしこれら4つの範囲すべてを印刷したいのであれば別の書き方が必要です。
（きまぐれおじさん） 2021/03/24(水) 12:06

「すべてのチェックボックスのうちどれか一つでもTrueがあれば」というと、
Dim i As Variant
For Each i In CheckBox.Value 

   Me.i.Count = True
Next   
Else: MsgBox "選択されていません"
としか思いつきませんがエラー出てしまいました。

また、チェック2以降のチェックが入っていると印刷範囲を追加するのではなく上書き
つまり、チェック4まですべて入っていると、設定される印刷範囲は"B39:E49"だけです。

こちらで正しいですしとてもとてもわかりやすい説明ありがとうございます。チェックされた範囲だけ印刷したいのですが、思いつきません。
（ETE） 2021/03/24(水) 13:09

次はこれですが、清々しいほどに滅茶苦茶なので、なるべく元の形を活かしつつ
「チェックボックスに一つでもチェックが入っていたら「印刷しますか？」とメッセージを出してYESを押したら印刷プレビューを出す」コードにしてみます。 

    With ActiveSheet
        For i = 1 To 4
            If Me.Controls("Checkbox" & i) = False Then
                MsgBox "選択されていません"
                i = i + 1
            ElseIf Me.Controls("Checkbox" & i) = True >= 1 Then
                If Result = vbYes Then
                    'Yesを選択され場合の処理
                    Else
                        MyStr = "印刷しますか？"
                        If Me.Controls("Checkbox" & i) = True > 1 Then
                            Me.Controls("Checkbox" & i).PrintObject = Me.Controls("Checkbox" & i).Value
                            Result = MsgBox(MyStr, vbYesNo + vbExclamation)
                        Else
                            'Noを選択された場合の処理
                            Exit Sub
                    End If
                End If
            End If
        Next
    End With

以下修正コードとコメント 

    For i = 1 To 4
	'チェックが外れているチェックボックスの数を変数cntに納める
        If Me.Controls("Checkbox" & i) = False Then
            cnt = cnt + 1
        End If
    Next i
    'ここまでで印刷範囲の設定とチェックの有無の判定は済んでいるのでこの先では判定しない


    'すべてのチェックボックスのチェックが外れている場合cnt=4になる
    If cnt < 4 Then
        MyStr = "印刷しますか？"
        Result = MsgBox(MyStr, vbYesNo + vbExclamation)
        If Result = vbYes Then
            'Yesを選択され場合の処理
            Activesheet.PrintPreview	'印刷プレビューを表示（上の部分のWorksheets("Sheet1")と整合性がないので注意）
        Else
            'Noを選択された場合の処理
            Exit Sub
        End If
    Else
        MsgBox "選択されていません"
    End If

※.PrintObjectは、「そのオブジェクト（この場合はチェックボックス）を印刷するかどうかの設定」なので削除
（きまぐれおじさん） 2021/03/24(水) 13:24

チェック１、チェック２、チェック３、チェック４すべてチェックあり　→　印刷範囲　"B39:E49"
チェック１、チェック３、チェック４チェックあり　→　印刷範囲　"B3:E13"　（チェック２にチェックがないのでその後の判定をしない）
チェック２、チェック３、チェック４チェックあり　→　印刷範囲　なし　（チェック１にチェックがないのでその後の判定をしない）

これで良いですか？
（きまぐれおじさん） 2021/03/24(水) 13:29

参考までに別の印刷範囲選択方法を紹介します。 

    '前のチェックが入ってなくても判定する（下の判定が印刷範囲上書き）
    If CheckBox1 = True Then
        Worksheets("Sheet1").PageSetup.PrintArea = "B3:E13"
    End If
    If CheckBox2 = True Then
        Worksheets("Sheet1").PageSetup.PrintArea = "B15:E25"
    End If
    If CheckBox3 = True Then
        Worksheets("Sheet1").PageSetup.PrintArea = "B27:E37"
    End If
    If CheckBox4 = True Then
        Worksheets("Sheet1").PageSetup.PrintArea = "B39:E49"
    End If


    'チェックが入っている範囲を追加
    Dim prtArea As String
    If CheckBox1 = True Then
        prtArea = "B3:E13,"
    End If
    If CheckBox2 = True Then
        prtArea = prtArea & "B15:E25,"
    End If
    If CheckBox3 = True Then
        prtArea = prtArea & "B27:E37,"
    End If
    If CheckBox4 = True Then
        prtArea = prtArea & "B39:E49,"
    End If
    If Right(prtArea, 1) = "," Then
        prtArea = Left(prtArea, Len(prtArea) - 1)
        Worksheets("Sheet1").PageSetup.PrintArea = prtArea
    End If

（きまぐれおじさん） 2021/03/24(水) 13:52

詳しい説明ありがとうございます。
コードを試してみました。思いつかないものばかりで大変ためになります。
ユーザーフォームからの指示をしていたのですが、プレビュー画面になると、ユーザーフォームが開いた状態で何もできない状態になってしまったので最後にUnload　Meを追加したのですが何もできないのは変わらずでした。対処方法他にありますでしょうか？
（ETE） 2021/03/24(水) 16:58
すみません。印刷範囲を見落としていました。
チェック１、チェック２、チェック３、チェック４すべてチェックあり　
→　印刷は　1枚目B3:E13　2枚目B15:E25　3枚目B27:E37　4枚目B39:E49

チェック１、チェック３、チェック４チェックあり　
→　印刷は　1枚目B3:E13　2枚目B27:E37　3枚目　4枚目B39:E49

チェック２、チェック３、チェック４チェックあり
→　印刷は　2枚目B15:E25　3枚目B27:E37　4枚目B39:E49

としたいです。こう考えると冒頭の質問からすると、印刷範囲というより(ページ設定？)1枚で収容するとなってしまいますが
上記のようにしたいです。申し訳ありません。訂正いたします。
（ETE） 2021/03/24(水) 17:25

たびたびすみません。ご指示いただいたものを参考に下記のようにやらせていただきまして、できました。ページ設定？されているコードなのですね。色々、見切り発車で申し訳ありません。
'前のチェックが入ってなくても判定する（下の判定が印刷範囲上書き） 
    If CheckBox1 = True Then
        Worksheets("Sheet1").PageSetup.PrintArea = "B3:E13"
    End If
    If CheckBox2 = True Then
        Worksheets("Sheet1").PageSetup.PrintArea = "B15:E25"
    End If
    If CheckBox3 = True Then
        Worksheets("Sheet1").PageSetup.PrintArea = "B27:E37"
    End If
    If CheckBox4 = True Then
        Worksheets("Sheet1").PageSetup.PrintArea = "B39:E49"
    End If
    'チェックが入っている範囲を追加
    Dim prtArea As String
    If CheckBox1 = True Then
        prtArea = "B3:E13,"
    End If
    If CheckBox2 = True Then
        prtArea = prtArea & "B15:E25,"
    End If
    If CheckBox3 = True Then
        prtArea = prtArea & "B27:E37,"
    End If
    If CheckBox4 = True Then
        prtArea = prtArea & "B39:E49,"
    End If
    If Right(prtArea, 1) = "," Then
        prtArea = Left(prtArea, Len(prtArea) - 1)
        Worksheets("Sheet1").PageSetup.PrintArea = prtArea
    End If


 For i = 1 To 4
    'チェックが外れているチェックボックスの数を変数cntに納める
        If Me.Controls("Checkbox" & i) = False Then
            cnt = cnt + 1
        End If
    Next i
    'ここまでで印刷範囲の設定とチェックの有無の判定は済んでいるのでこの先では判定しない
    'すべてのチェックボックスのチェックが外れている場合cnt=4になる
    If cnt < 4 Then
        MyStr = "印刷しますか？"
        Result = MsgBox(MyStr, vbYesNo + vbExclamation)
        If Result = vbYes Then
        Unload Me
            'Yesを選択され場合の処理
            ActiveSheet.PrintPreview    '印刷プレビューを表示（上の部分のWorksheets("Sheet1")と整合性がないので注意）
        Else
            'Noを選択された場合の処理
            Exit Sub
        End If
    Else
        MsgBox "選択されていません"
    End If

（ETE） 2021/03/24(水) 17:44

理解せずに闇雲にコードを適用しているとひどい目に遭うこともありますので注意してください。
いちおう整理したものを置いておきます。 

    Private Sub CommandButton1_Click()
        Dim preArea As String
        Dim prtArea As String
        'チェックが入っている範囲を追加
        If CheckBox1.Value Then prtArea = "B3:E13,"
        If CheckBox2.Value Then prtArea = prtArea & "B15:E25,"
        If CheckBox3.Value Then prtArea = prtArea & "B27:E37,"
        If CheckBox4.Value Then prtArea = prtArea & "B39:E49,"
        Select Case True
            'prtAreaが""だった(CheckBox1～4すべてチェックが外れているとprtAreaに文字が代入されない)場合は終了
            Case prtArea = "": MsgBox "選択されていません"
            Case MsgBox("印刷しますか？", vbYesNo + vbExclamation) = vbYes
                prtArea = Left(prtArea, Len(prtArea) - 1)   '文字列最後の","を削除
                With ActiveSheet
                    preArea = .PageSetup.PrintArea  'それまでの印刷範囲を退避
                    .PageSetup.PrintArea = prtArea  'チェックしたエリアを印刷範囲に指定
                    Me.Hide                         'ユーザーフォームを隠す
                    .PrintPreview                   '印刷プレビュー表示
                    .PageSetup.PrintArea = preArea  '印刷範囲を元に戻す
                    Me.Show                         'ユーザーフォーム再表示
                End With
        End Select
    End Sub

（きまぐれおじさん） 2021/03/25(木) 10:24

ご丁寧な説明ありがとうございます。
思いつかないものばかりで大変勉強になりました。
（ETE） 2021/03/25(木) 16:24
コメント返信：

[ 一覧(最新更新順) ]

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