Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Dim cell As Range
Dim redCell As Range
Dim columnLetter As String
' アクティブなワークシートを取得
Set ws = ActiveSheet
' 各セルを確認し、赤文字があるかどうかをチェック
For Each cell In ws.UsedRange
If cell.Font.Color = RGB(255, 0, 0) Then
' 赤文字がある場合
Set redCell = cell
' 列のアルファベットを取得
columnLetter = Split(Cells(1, redCell.Column).Address, "$")(1)
' エラーメッセージを表示
MsgBox "エラーを修正してください" & vbCrLf & _
"対象項目: " & ws.Cells(redCell.Row, 5).Value & vbCrLf & _
"該当箇所: " & redCell.Row & "行目の" & columnLetter & "列", vbCritical, "エラー"
' ループを抜ける
Cancel = True
Exit For
End If
Next cell
End Sub
