'********1*********2*********3*********4*********5*********6*********7**********
'*: Description: 丸め処理
'*: Argments: d = 原データ
'*: FLG = 丸め区分(0:切り捨て 1:四捨五入 2:四捨五入)
'*: M = 小数の桁数
'********1*********2*********3*********4*********5*********6*********7**********
Public Function CF_cRound(ByVal d As Currency,FLG As Integer,M As Integer) As Currency
Dim buf1 As Long
Dim buf2 As Currency
Dim Fugo As Integer
If d <> 0 And M >= 0 Then
Fugo = 0
If Sgn(d) = -1 Then 'ﾏｲﾅｽの場合
Fugo = 1 'Fugoﾌﾗｸﾞ = 1
End If
d = Abs(d) '絶対値に換算
buf1 = 10 ^ M
If FLG = 0 Then '切り捨て
buf2 = d * buf1
buf2 = Int(buf2)
ElseIf FLG = 1 Then '四捨五入
buf2 = d * buf1 + 0.5
buf2 = Int(buf2)
ElseIf FLG = 2 Then '切り上げ
buf2 = d * buf1 + 0.9
buf2 = Int(buf2)
End If
If Fugo = 1 Then
CF_cRound = (buf2 / buf1) * -1
Else
CF_cRound = buf2 / buf1
End If
Else
CF_cRound = d
End If
End Function
‘*******************************************
Public Function CF_Chk_Shosu(ip_Text As String,ip_Seisu As Integer,ip_Shosu As Integer) As Boolean
'*: Argments: ip_Text = チェック対象の文字列
'*: ip_Seisu = 整数部桁数
'*: ip_Shosu = 小数部桁数
On Error GoTo Err_Exit
Dim strText As String
Dim intLen As Integer
Dim Pnt As Integer
'数値として認識できなければエラー
If IsNumeric(ip_Text) = False Then
CF_Chk_Shosu = False
Exit Function
End If
'頭にゼロがついていた場合削除
strText = CStr(CDbl(ip_Text))
intLen = Len(strText)
'小数点位置を判定
Pnt = InStr(strText,".")
'小数点なし
If Pnt = 0 Then
'桁数チェック
If intLen <= ip_Seisu Then
CF_Chk_Shosu = True
Else
CF_Chk_Shosu = False
End If
'整数部桁数オーバー
ElseIf Pnt - 1 > ip_Seisu Then
CF_Chk_Shosu = False
'小数部桁数オーバー
ElseIf intLen - Pnt > ip_Shosu Then
CF_Chk_Shosu = False
'正常
Else
CF_Chk_Shosu = True
End If
Exit Function
Err_Exit:
CF_Chk_Shosu = False
End Function