複数シートの保護時に任意の設定を行う処理(事前にシートが存在するかもチェック)

Sub prcProtectSheets()
    ' 変数の宣言
    Dim arrSheetNames() As String ' シート名の配列
    Dim strPassword As String ' シート保護のパスワード
    Dim strMissingSheets As String ' 存在しないシート名のリスト
    Dim i As Integer ' ループカウンタ
    Dim wbk As Workbook ' 対象ワークブック
    
    ' 対象ワークブックを設定
    Set wbk = ActiveWorkbook

    ' シート名の配列を初期化
    arrSheetNames = Array("Sheet1", "Sheet2", "Sheet3") ' 必要なシート名を入力

    ' パスワードを設定
    strPassword = "password123" ' 任意のパスワードを設定
    
    ' シートの存在をチェック
    strMissingSheets = fncCheckSheetsExist(wbk, arrSheetNames)
    
    ' 存在しないシートがある場合はメッセージを表示して処理を終了
    If strMissingSheets <> "" Then
        MsgBox "以下のシートは存在しません: " & strMissingSheets, vbExclamation, "シートエラー"
        Exit Sub
    End If

    ' 各シートに対して保護をかける
    For i = LBound(arrSheetNames) To UBound(arrSheetNames)
        wbk.Sheets(arrSheetNames(i)).Protect Password:=strPassword
    Next i
End Sub

コメント