【EXCEL】数式を保護する

Sub ロック数式セル()
'------------------------------------------------------------------
' 関数: ロック数式セル
' 説明: Excelシート内の数式が含まれているセルのみをロックし、
'       シート全体の保護を適用する。
' 引数:
'   なし
' 戻り値:
'   なし
'
' 使用例:
'   ' 現在のアクティブシートで数式セルのみをロックする
'   Call ロック数式セル()
'------------------------------------------------------------------
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    ' アクティブシートを対象とする
    Set ws = ActiveSheet
    ' すべてのセルのロックを解除（初期化）
    ws.Cells.Locked = False
    ' ワークシートの使用範囲を取得
    Set rng = ws.UsedRange
    ' 数式を含むセルを検索してロック
    For Each cell In rng
        If cell.HasFormula Then cell.Locked = True
    Next cell
    ' ワークシートの保護を適用（パスワードなし）
    ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    MsgBox "数式セルをロックし、シートを保護しました。", vbInformation, "完了"
End Sub

(元のカレンダー.basを少し書き直し)

カレンダー.bas

Sub main()
'-----祝日シート追加-----
    ' 内閣府の祝日データを「holiday_j」と定義し、シートの最後に移動
    Dim wb As Workbook                  ' VBAを起動したワークブック用
    Set wb = ActiveWorkbook             ' wb.Name = Book1(初期起動時)
    Dim ws As Worksheet                 ' VBAを起動したワークシート用
    Set ws = ActiveSheet                ' ws.Name = Sheet1(初期起動時)
    Dim URL_data As String              ' 祝日データのURL用
     URL_data = "https://www8.cao.go.jp/chosei/shukujitsu/syukujitsu.csv"
    ' 昭和30年（1955年）から令和7年（2025年）国民の祝日（csv形式：20KB） (2024/07/14時点)
    ' 国民の祝日について - 内閣府 https://www8.cao.go.jp/chosei/shukujitsu/gaiyou.html
    Workbooks.Open URL_data             ' 祝日データをEXCELで開く
    Rows("1:1").Delete Shift:=xlUp      ' テキスト削除
    Columns("A:A").NumberFormatLocal = "[$-x-sysdate]dddd, mmmm dd, yyyy"
    ActiveWorkbook.Names.Add Name:="holiday_j", RefersTo:="=syukujitsu!$A:$A"
    Sheets("syukujitsu").Move After:=wb.Worksheets(wb.Worksheets.Count)
    ActiveSheet.Name = "祝日"           ' シート名を変更
    wb.Activate                         ' Moveのため新規時には不要
    ws.Activate                         ' 最初のシートを表示
'-----1か月カレンダー-----
    '3行目に年、月を入力：シート名をタイトルにした日曜始まりのカレンダー
    ws.Name = "壱ヶ月カレンダー"
    'セル全体の設定
    Cells.Select
        Call セル設定(11.89, 96#, 255, 255, 255)
        Call 文字設定_角POP(11, "黒", "中央")
    '各行の設定
    ' タイトル
    Rows("1:1").Select
        Call セル設定(11.89, 30#, 255, 255, 255)
    Range("A1:G1").Select
        Call 文字設定_角POP(22, "黒", "中")
        Cells(1, 1) = "=RIGHT(@CELL(""filename"",A1),LEN(@CELL(""filename"",A1))-FIND(""]"",@CELL(""filename"",A1)))"
    ' 空行
    Rows("2:2").Select
        Call セル設定(11.89, 13.2, 255, 255, 255)
    ' 年月入力
    Rows("3:3").Select
        Call セル設定(11.89, 21#, 255, 255, 255)
    Union(ws.Range("B3"), ws.Range("D3")).Select
        Call セル設定(11.89, 21#, 255, 255, 204)    ' 可変部分のみ背景色替え
        Call 文字設定_角POP(18, "黒", "右")         ' 可変部分は右寄せ
    Union(ws.Range("C3"), ws.Range("E3")).Select
        Call 文字設定_角POP(18, "黒", "左")
    Range("G3").Select
        Call 文字設定_角POP(18, "白", "左")         ' 隠し文字
    Range("B3:G3").Formula = Array(Format(Date, "yyyy"), "年", Format(Date, "mm"), "月", "", "=DATE(RC[-5],RC[-3],1)")
    ' 空行
    Rows("4:4").Select
        Call セル設定(11.89, 13.2, 255, 255, 255)
    ' 曜日
    Rows("5:5").Select
        Call セル設定(11.89, 22.2, 255, 255, 255)
    Range("A5").Select
        Call 文字設定_角POP(18, "赤", "中央")
    Range("B5:F5").Select
        Call 文字設定_角POP(18, "黒", "中央")
    Range("G5").Select
        Call 文字設定_角POP(18, "青", "中央")
    Range("A5:G5").Formula = Array("日", "月", "火", "水", "木", "金", "土")
    ' 日付欄
    Dim i As Byte
    Dim j As Byte
    For i = 6 To 11                     ' 6行目から11行目
        If i = 6 Then                   ' セルA6のみ例外処理
            Application.ReferenceStyle = xlR1C1
            Cells(6, 1).NumberFormatLocal = "d"
            Cells(6, 1) = "=R[-3]C[6]-WEEKDAY(R[-3]C[6])+1"
            Application.ReferenceStyle = xlA1
        Else
            Application.ReferenceStyle = xlR1C1
            Cells(i, 1).NumberFormatLocal = "d"
            Cells(i, 1) = "=R[-1]C[6]+1"
            Application.ReferenceStyle = xlA1
        End If
        For j = 2 To 7                  ' B列からG列まで
            Application.ReferenceStyle = xlR1C1
            Cells(i, j).NumberFormatLocal = "d"
            Cells(i, j) = "=RC[-1]+1"   ' 左の列+1
            Application.ReferenceStyle = xlA1
        Next j
    Next i
    '-----条件付き書式設定 の ルール設定-----
    Cells.FormatConditions.Delete
    Range("A6:G11").Select
    ' 条件設定① 今月以外を「白」
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=MONTH(A6)<>$D$3"
    Selection.FormatConditions(1).Font.Color = RGB(255, 255, 255)
    ' 条件設定② 祝日を「赤」
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF(holiday_j,A6)>0"
    Selection.FormatConditions(2).Font.Color = RGB(255, 0, 0)
    ' 条件設定③ 日曜日を「赤」
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=WEEKDAY(A6)=1"
    Selection.FormatConditions(3).Font.Color = RGB(255, 0, 0)
    Selection.FormatConditions(3).StopIfTrue = False
    ' 条件設定④ 土曜日を「青」
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=WEEKDAY(A6)=7"
    Selection.FormatConditions(4).Font.Color = RGB(0, 0, 255)
    Selection.FormatConditions(4).StopIfTrue = False
    '-----罫線設定-----
    Range("A6:G11").Borders.LineStyle = xlContinuous
End Sub


Function セル設定(幅 As Single, 高 As Single, 背景R As Byte, 背景G As Byte, 背景B As Byte)
'------------------------------------------------------------------
' 関数: セル設定
' 説明: 指定された列の幅、行の高さ、および背景色を設定する。
' 引数:
'   幅      - 設定する列の幅 (Single型)
'   高      - 設定する行の高さ (Single型)
'   背景R   - 背景色の赤成分 (Byte型、0～255)
'   背景G   - 背景色の緑成分 (Byte型、0～255)
'   背景B   - 背景色の青成分 (Byte型、0～255)
' 戻り値:
'   なし (選択範囲に対して直接適用)
'
' 使用例:
'   ' 列幅を11.89, 行の高さを13.2, 背景色を白色に設定
'   Call セル設定(11.89, 13.2, 255, 255, 255)
'------------------------------------------------------------------
    With Selection
        .ColumnWidth = 幅
        .RowHeight = 高
        .Interior.Color = RGB(背景R, 背景G, 背景B)
    End With
End Function

Function 文字設定_角POP(サイズ As Single, 文字色 As String, 横位置 As String)
'------------------------------------------------------------------
' 関数: 文字設定_角POP
' 説明: 指定されたフォントサイズ・文字色・横位置に基づいて、
'       選択範囲の文字のフォント設定を変更する。
' 引数:
'   サイズ   - 設定するフォントサイズ (Single型)
'   文字色   - 変更する文字色 ("黒"、"白"、"赤"、"緑"、"青"、"水"、"紫"、"黄" など)
'   横位置   - 水平方向の文字揃え ("左"、"中央"、"中"、"右" など)
' 戻り値:
'   なし (選択範囲に対して直接適用)
'
' 使用例:
'   ' 文字サイズを18pt、文字色を「赤」、横位置を「中央」に設定する
'   Call 文字設定_角POP(18, "赤", "中央")
'------------------------------------------------------------------
    Dim 色辞書 As Object, 位置辞書 As Object
    Set 色辞書 = CreateObject("Scripting.Dictionary")
    Set 位置辞書 = CreateObject("Scripting.Dictionary")
    ' 文字色のRGB定義
    色辞書.Add "黒", RGB(0, 0, 0)
    色辞書.Add "白", RGB(255, 255, 255)
    色辞書.Add "赤", RGB(255, 0, 0)
    色辞書.Add "緑", RGB(0, 255, 0)
    色辞書.Add "青", RGB(0, 0, 255)
    色辞書.Add "水", RGB(0, 255, 255)
    色辞書.Add "紫", RGB(255, 0, 255)
    色辞書.Add "黄", RGB(255, 255, 0)
    ' 横位置の定義
    位置辞書.Add "左", xlLeft
    位置辞書.Add "中央", xlCenter
    位置辞書.Add "中", xlCenterAcrossSelection
    位置辞書.Add "右", xlRight
    ' 設定適用
    With Selection
        .Font.Name = "HGP創英角ﾎﾟｯﾌﾟ体"
        .Font.FontStyle = "標準"
        .Font.Size = サイズ
        .Font.Color = IIf(色辞書.Exists(文字色), 色辞書(文字色), RGB(16, 16, 16))
        .VerticalAlignment = xlGeneral
        .HorizontalAlignment = IIf(位置辞書.Exists(横位置), 位置辞書(横位置), xlGeneral)
    End With
End Function

Array、辞書型変数に修正。😅

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up

【EXCEL】数式を保護する

やること

事前確認：Qiitaでの記事

通常の使い方とパスワードに関して ほか

VBA使用

Office Scripts使用

PowerShell使用

VB.NET使用

JavaScript使用

Python使用

Java使用

事例

通常の使い方とパスワードに関してほか