すべてのシートでマクロを実行したい

質問

以下のプログラムでは、選択したシートのみマクロが動作しています。ネット検索で見よう見まねで作ったため何がまちがっているのかわかりません。ご教示いただけるとありがたいです。

・月の予定表で利用者が休みの日に斜線を引くマクロ
・入力ミスを防ぐためシート保護をしている

Sub すべてのシート()
Dim s As Worksheet
For Each s In Worksheets
s.Select
Call 斜線
Next
End Sub

Sub 斜線()

ActiveSheet.Unprotect Password:="1234"

For i = 1 To Range("E10").End(xlDown).Row

Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlNone

If Range("E10").Value = 0 Then Exit Sub

If Cells(i, "E").Value = "日" And Range("BP9").Value = 0 Then
Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous
End If

If Cells(i, "E").Value = "月" And Range("BP10").Value = 0 Then
Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous
End If

If Cells(i, "E").Value = "火" And Range("BP11").Value = 0 Then
Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous
End If

If Cells(i, "E").Value = "水" And Range("BP12").Value = 0 Then
Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous
End If

If Cells(i, "E").Value = "木" And Range("BP13").Value = 0 Then
Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous
End If

If Cells(i, "E").Value = "金" And Range("BP14").Value = 0 Then
Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous
End If

If Cells(i, "E").Value = "土" And Range("BP15").Value = 0 Then
Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous
End If

If Cells(i, "AY").Value = "祝日" And Range("BP16").Value = 0 Then
Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous
End If

Next i

ActiveSheet.Protect Password:="1234"

End Sub

回答No.1

kkkkkm · ベストアンサー

標準モジュールでコードを実行していればできると思いますが、シートモジュールで実行するとエラーになると思います。

セルの対象シートを指定して実行してみてください。
複数シートを対象にする場合は特にセルのシート指定はした方がいいと思います。

Sub すべてのシート()
Dim s As Worksheet
For Each s In Worksheets
Call 斜線(s)
Next
End Sub

Sub 斜線(ByRef s As Worksheet)

With s
.Unprotect Password:="1234" '前にドットがあります
.Activate '前にドットがあります。

'以下RangeやCellsの前にドットがあります。

For i = 1 To .Range("E10").End(xlDown).Row

.Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlNone

If .Range("E10").Value = 0 Then Exit Sub

If .Cells(i, "E").Value = "日" And .Range("BP9").Value = 0 Then
.Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous
End If
中略

Next i
.Protect Password:="1234" '前にドットがあります
End With

End Sub

あと、If文が多くなっていますからCase文にしてもいいかもしれません。

Select Case True
Case .Cells(i, "E").Value = "日" And .Range("BP9").Value = 0
.Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous

Case .Cells(i, "E").Value = "月" And .Range("BP10").Value = 0
.Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous

'中略
Case Else

End Select

お礼

ご教示ありがとうございます。標準モジュールとして作成しています。
行き詰まっていたので助かりました。一行一行理解しながら確認させていただき、ご報告差し上げます。

回答No.4

HohoPapa

If Range("E10").Value = 0 Then Exit Sub

上記の行がどのような意図で書かれているのかが未詳ですが
少なくとも、E10セルがゼロ、または空欄であれば、
そのシートは、
それ以降の行は全数飛ばされてしまい、

ActiveSheet.Protect Password:="1234"

このコードすら実行されません。

どのシートも

ActiveSheet.Protect Password:="1234"

を実行するためには、

If Range("E10").Value = 0 Then Exit Sub

ではなく

If Range("E10").Value = 0 Then Exit For

とする必要があります。

お礼

利用日未定の日付が空白の利用者向けシート作成をするために設けました。
まさにシート保護せず抜けてしまっていることに先ほど気がついて、どうするか考えていたところでした。タイムリーなご助言恐れ入ります。実行したところ、シート保護されました。ありがとうございました。

回答No.3

kkkkkm

> 選択したシートのみマクロが動作しています

これが
それぞれのシートをSelectで表示しないと結果が出ないので
s.Select
にしているけど、Selectせずにどのシートも結果を出したいという意味でしたら

No.1のコードの

.Activate '前にドットがあります。

を外してください。

お礼

丁寧な解説とお手本のプログラムをつけてくださり感謝申しあげます。

>あと、If文が多くなっていますからCase文にしてもいいかもしれません。
Case文を使う事ですっきりました。

>もしかして、実行されないと思われるシートで曜日のセルが本来日付で入力されていて表示形式で曜日になるようになっていないでしょうか。
お察しのとおりです。ValueをTextに変更しました。

> 選択したシートのみマクロが動作しています これが それぞれのシートをSelectで表示しないと結果が出ないので s.Select にしているけど、
いまひとつSelectするしないの意味がわかってないですが、どのシートも結果を出したいので、「.Activate '前にドットがあります。」をはずしました。この効果か完了までの時間が45秒から15秒に短縮できました（20シート分）。

おかげさまで問題なくすべてのシートに正しく斜線が引かれました！本当にありがとうございました！
ひとまず安心しましたが、新たに２点問題が見つかりました。これらについてはさらに試行錯誤してみます。
１）利用日未定の利用者向けは、シート保護をしないで抜けている
'If .Range("E10").Value = 0 Then Exit Sub
２）シート保護時セルの書式設定を許可
'.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True

ともあれ丁寧なご回答、本当に助かりました。ありがとうございました。

回答No.2

kkkkkm

> 標準モジュールとして作成しています。

とすれば全てのシートで実行されると思うのですが、もしかして、実行されないと思われるシートで曜日のセルが本来日付で入力されていて表示形式で曜日になるようになっていないでしょうか。

たとえば、データは「2021/12/5」で表示形式を「aaa」にしているので表示が「日」となっている状態でしたら、Valueでは「日」と認識されていないので、条件が一致していると思われるのに実行されていないように見えます。

その場合

Cells(i, "E").Value = "日"

を

Cells(i, "E").Text = "日"

に変更してみてください。

お礼

小まめなフォローありがとうございました。
シート保護の件も解決しましたのでご報告いたします。