シート名一致すれば印刷、一致しなければメッセージｂｏｘ

ｖｂａ初心者です。ネットを見ながら作成していますがどうしてもわかりません教えてください。

条件として
Ｓheet1のセルA2からA5にワークシート名（sheet1以外）を入れます。
Ｓheet1のセルB2からB5に印刷枚数をいれます。
例えば、A2「123」B2「「1」と入力すると、シート「123」を1枚印刷するようにしたいです。
但し、セルＡ３と一致するシートが無い場合は印刷を行わず、セルA4の印刷を実行、セルA5と一致するシートが無い場合は印刷を行わないようにしたいです。
最後にメッセージｂｏｘで印刷のできなかったシート名（＝Ａ列の値）を出したいです。

下記コードで印刷はできるのですが、シートが無かった場合の処理で止まってしまいます。
申し訳ありませんがお助けください。よろしくお願いします。



Sub 印刷()

Dim atai As String
Dim i As Long
Dim wS As Worksheet
Dim flag As Boolean


With Sheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
For Each wS In Worksheets
If wS.Name = .Cells(i, "A").Value Then flag = True
Next wS
If flag = True Then
atai = .Cells(i, "A").Value
Sheets(atai).PrintOut Copies:=.Cells(i, "B").Value
Else
MsgBox atai, vbInformation, vbInformation

End If

Next
End With

End Sub

No.4 ベストアンサー 回答者： WindFaller 回答日時： 2019/07/06 21:27

>シートが無かった場合の処理で止まってしまいます。

私がずいぶん前から使っている方法です。

　dummy = Evaluate(ShName & "!A1") 'シートチェック用のダミー
　If Not IsError(dummy)
という方法を取ります。しかし、以下では、次に飛ばさずに、メッセージを出して止まってしまいます。その代わりに、C列の同じ行数に「済」を入れるようにしています。なお、フォーム・コントロールのボタンにつけると良いかと思います。

'//
Sub PrintButton_Click()
　Dim ShName As String
　Dim Pg As Long
　Dim i As Long, dummy As Variant
　With Worksheets("Sheet1")
　　For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
　　　ShName = .Cells(i, 1).Value
　　　dummy = Evaluate(ShName & "!A1") 'シートチェック用のダミー
　　　Pg = .Cells(i, 2).Value

　　　If .Cells(i, 3).Value = "" Then　　'「済」判のチェック
　　　　If Not IsError(dummy) And Pg > 0 Then
　　　　　Worksheets(ShName).PrintOut Copies:=Pg　', Preview:=True '試験用
　　　　　DoEvents 'Esc を活かす
　　　　　.Cells(i, 3).Value = "済" '印刷したら「済」を入れる
　　　　Else
　　　　　MsgBox "シート" & ShName & "を" & Pg & "枚印刷する命令は無効です。", vbCritical
　　　　　Exit For
　　　　End If
　　　End If
　　Next i
　　.Select '念の為
　End With
End Sub

この回答へのお礼

WindFallerさん　お返事ありがとうございます。

標準モジュールで試したら無事うまくいきました。
本当に色々なやり方があるのだなと感心させられます。

難しいところもあるので、ゆっくりと解読していきたいと思います。
教えてｇｏｏで質問すると、自分とのレベルの差を感じます。

これからもよろしくお願いします。

お礼日時：2019/07/06 22:05

No.5 回答者： WindFaller 回答日時： 2019/07/07 03:05

No.4の回答者です。

返事ありがとうございます。
私のコードはパーツで気に入った所があってら、それを使えばよいです。

これは、教えて!goo で覚えた方法です。
dummy = Evaluate(ShName & "!A1") 'シートチェック用のダミー

でも、質問のコードを直すというのか、最近の掲示板の流れのようですから、ちゃんとした解答にしておきます。
以下のようにすると、全体的には長くなりますが、とても分かりやすくなると思います。


'//ご質問のコードを直してみました。
Sub 印刷r()
　Dim atai As String
　Dim i As Long, cnt As Long
　Dim flag As Boolean

　With Sheets("Sheet1")
　　For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
　　　atai = .Cells(i, "A").Value
　　　cnt = .Cells(i, "B").Value　'先に変数に入れておく
　　　If IsShName(atai) And cnt > 0 Then　'ここでユーザー定義関数を使う　簡単になりました。
　　　 Sheets(atai).PrintOut Copies:=cnt　'No.4の回答者です。

返事ありがとうございます。
私のコードはパーツで気に入った所があってら、それを使えばよいです。

これは、教えて!goo で覚えた方法です。
dummy = Evaluate(ShName & "!A1") 'シートチェック用のダミー
との質問のコードを直すというのか、最近の掲示板の流れのようですから、ちゃんとした回答を出しておきます。


'//ご質問のコードを直してみました。
Sub 印刷r()
　Dim atai As String
　Dim i As Long, cnt As Long
　Dim flag As Boolean

　With Sheets("Sheet1")
　　For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
　　　atai = .Cells(i, "A").Value
　　　cnt = .Cells(i, "B").Value　'先に変数に入れておく
　　　If IsShName(atai) And cnt > 0 Then　'ここでユーザー定義関数を使う
　　　 Sheets(atai).PrintOut Copies:=cnt ', Preview:=True '実験用 プレビューで留まります。
　　　Else
　　　 MsgBox atai & "というシートはありません。", vbCritical
　　　End If
　　Next
　 End With
End Sub

'ユーザー定義関数でシート名をチェック
Function IsShName(wS As Variant) As Boolean
Dim sh As Object
For Each sh In Sheets
　If LCase(wS) = LCase(sh.Name) Then　　'両方とも小文字にする
　 IsShName = True
　 Exit Function '見つかったら、ループより抜ける
　End If
Next
End Function
　　　Else
　　　 MsgBox atai & "というシートはありません。", vbCritical
　　　End If
　　Next
　 End With
End Sub

'ユーザー定義関数でシート名をチェック
Function IsShName(wS As Variant) As Boolean
Dim sh As Object
For Each sh In Sheets
　If LCase(wS) = LCase(sh.Name) Then　　'両方とも小文字にする
　 IsShName = True
　 Exit Function '見つかったら、ループより抜ける
　End If
Next
End Function

この回答へのお礼

WindFallerさん　お返事ありがとうございます。

コードを解読して、気に入ったものがあれば使用させていただきます。
教えてｇｏｏは親切な方ばかりで感謝です。

お礼日時：2019/07/07 07:49

No.3 回答者： taku-9023.ham 回答日時： 2019/07/06 21:13

ごめんなさい、間違えました。

これでいけるはずです。

If flag = True Then
Sheets(atai).PrintOut Copies:=.Cells(i, "B").Value
Else
atai = .Cells(i, "A").Value
MsgBox atai, vbInformation, vbInformation
End If

この回答へのお礼

taku-9023.hamさん　お返事ありがとうございます。

やってみましたが、うまくいきません。

お礼日時：2019/07/06 21:38

No.2 回答者： taku-9023.ham 回答日時： 2019/07/06 21:11

If flag = True Then

Sheets(atai).PrintOut Copies:=.Cells(i, "B").Value
Else
atai = .Cells(i, "A").Value
End If
next

MsgBox atai, vbInformation, vbInformation

下のところを
としたらどうでしょう？

No.1 回答者： bonaron 回答日時： 2019/07/06 17:35

flag が初期化されていませんね。

一度シートが見つかると、
flag が True のままですから
次のシートが見つからなかった場合にも

　If flag = True Then　' ＜－－－ 真になってしまうので
　　atai = .Cells(i, "A").Value
　　Sheets(atai).PrintOut Copies:=.Cells(i, "B").Value

印刷されてしまいます。


flag のリセット処理を追加しましょう。
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
　flag = False　　' ここで初期化
　For Each wS In Worksheets

この回答へのお礼

bonaronさんお返事ありがとうざいます。

早速試してみたのですが、一部解決して一部未解決です。
エラー解消をして最後まで進むようになったところまではよかったのですが、
わたしのコードが根本的に間違っていたので、メッセージＢＯＸに表示されるコメントが
印刷できなかったものではなく、印刷をしたものが表示されてしまいます。

今必死で解決策を探しているのですが、分かればすごく嬉しいです。

お礼日時：2019/07/06 18:10