refactor error

This commit is contained in:
updsv7
2026-04-21 12:24:49 +09:00
parent 6f2bb324e4
commit e2e115b7f4
9 changed files with 246 additions and 320 deletions

View File

@@ -320,11 +320,111 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
End If
End Function
Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param As String = "") As String
Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String = "", Optional ByVal param1 As String = "") As String
Dim errorList As Object: Set errorList = GetErrorList()
Dim errorMessage As String
If errorList.Exists(errorCode) Then
errorMessage = MakeSelect(errorCode, Replace(errorList(errorCode)(0), "{0}", param))
errorMessage = Replace(errorList(errorCode)(0), "{0}", param0)
errorMessage = Replace(errorMessage, "{1}", param1)
errorMessage = MakeSelect(errorCode, errorMessage)
End If
GetErrorMsg = errorMessage
End Function
Function ColLetter(colNum As Long) As String
ColLetter = Split(Cells(1, colNum).Address, "$")(1)
End Function
Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
If checkValue = "" Then
Dim letter As String: letter = ColLetter(colNum)
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", letter & rowNum)
ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
CheckRequired = False
Exit Function
End If
CheckRequired = True
End Function
Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
If Len(checkValue) <> charLength Then
Dim letter As String: letter = ColLetter(colNum)
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E006", letter & rowNum, charLength)
ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
CheckChar = False
Exit Function
End If
CheckChar = True
End Function
Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
Dim letter As String: letter = ColLetter(colNum)
Dim i As Long
Dim ch As String
For i = 1 To charLength
ch = Mid(checkValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", letter & rowNum)
ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
CheckAlphanumeric = False
Exit Function
End If
Next i
CheckAlphanumeric = True
End Function
Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal varcharLength As Long, ByVal errorCol As String)
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
If Len(checkValue) > varcharLength Then
Dim letter As String: letter = ColLetter(colNum)
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E007", letter & rowNum)
ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
CheckVarcharOver = False
Exit Function
End If
CheckVarcharOver = True
End Function
Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
Dim letter As String: letter = ColLetter(colNum)
If checkValue <> "" Then
If Len(checkValue) <> 1 Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum)
ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
Check01 = False
Exit Function
End If
If checkValue <> "0" And checkValue <> "1" Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E008", letter & rowNum)
ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
Check01 = False
Exit Function
End If
End If
Check01 = True
End Function
Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
Dim letter As String: letter = ColLetter(colNum)
If checkValue <> "" Then
If Len(checkValue) <> 1 Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum)
ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
Check12 = False
Exit Function
End If
If checkValue <> "1" And checkValue <> "2" Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E009", letter & rowNum)
ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
Check12 = False
Exit Function
End If
End If
Check12 = True
End Function