Option Explicit
'賞与フォーム
'支給区分「１」固定

Private mobjWS() As Worksheet   'ワークシート
'mobjWS(0):Sheet5:給与データ
'mobjWS(1):Sheet1:雇用保険情報
'mobjWS(2):Sheet2:社員情報
'mobjWS(3):Sheet4:社員別社会保険情報

Private mlngFID As Long         '外部キー
Private mintNinzu As Integer    '扶養親族数
Private mlngRow As Long         'レコード
Private mlngTeigaku As Long     '月額標準報酬額による社会保険料
Private mintKenkou As Integer   '政府管掌健康保険；「０」未加入；「１」加入
Private mintKeitai As Integer   '雇用形態区分；「０」取締役；「１」一般；「２」パート；「３」アルバイト
Private mintKubun As Integer    '雇用保険区分；「０」Ａ欄；「１」Ｂ欄；「２」未加入
Private mintZaisyoku As Integer '在職退職区分；「０」在職；「１」死亡退職；「２」普通退職
Const mintSikyu As Integer = 1  '支給区分

'クリアボタン
Private Sub cmdClear_Click()

    'コントロールのレフレッシュ
    If cmdOK.Enabled = False Then cmdOK.Enabled = True
    Call NewData
    Call GetSyainList
    
End Sub

'削除ボタン
Private Sub cmdDelete_Click()

    Dim intMsg As Integer   'メッセージ
    
    intMsg = MsgBox("削除しますか。", 32 + 4, "給与計算システム")
    If intMsg = 6 Then mobjWS(0).Cells(mlngRow, 1).EntireRow.Delete
    MsgBox "正常に削除しました。", 64 + 0, "給与計算システム"
    
    Call NewData
    Call GetSyainList

End Sub

'終了ボタン
Private Sub cmdEND_Click()

    Unload Me
    
End Sub

'登録ボタン
Private Sub cmdOK_Click()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim intMsg As Integer           'メッセージの戻り値
    Dim i As Integer                '整数型カウンタ

    intMsg = MsgBox("登録しますか。", 32 + 4, "給与計算システム")
    
    '登録
    If intMsg = 6 Then
        '支給日の検査
        If IsDate(Me.txtDate.Text) = False Then GoTo DateErrorProc
        '金額の検査
        For i = 1 To 9
            Set objText = Controls("txtSyouyo" & CStr(i))
            If objText.Text = "" Then objText.Text = 0
            If IsNumeric(objText.Text) = False Then GoTo NumberErrorProc
        Next
        
        Call LetData
        
        MsgBox "正常に登録しました。", 64 + 0, "給与計算システム"
        
        Call NewData
        Call GetSyainList
    End If
    
    Set objText = Nothing
    
    Exit Sub
    
NumberErrorProc:

    MsgBox "金額の値が不正です。", 16 + 0, "給与計算システム"
    Exit Sub
    
DateErrorProc:

    MsgBox "支給日の値が不正です。", 16 + 0, "給与計算システム"

End Sub

'支給日リストの選択
Private Sub lstDate_Click()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim intMsg As Integer           'メッセージの戻り値
    Dim lngID As Long               '支給日の主キー
    Dim i As Integer                '整数型カウンタ
    
    intMsg = MsgBox("訂正しますか。", 32 + 4, "給与計算システム")
    
    '「はい」のとき
    If intMsg = 6 Then
        For i = 1 To 12
            Set objText = Controls("txtSyouyo" & CStr(i))
            objText.Text = 0
        Next
        
        'If Me.cmdDelete.Enabled = False Then Me.cmdDelete.Enabled = True
        '主キー取得
        lngID = Me.lstDate.List(Me.lstDate.ListIndex, 0)
        'ワークシートの値を取得
        Call GetData(lngID)
    End If

    Set objText = Nothing
    
End Sub

'社員リストを選択したとき
Private Sub lstSyain_Click()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim lngRow1 As Long             '社員情報レコード
    Dim lngRow2 As Long             'カレントレコード
    Dim datKisyu As Date            '期首年月日
    Dim datTaisyoku As Date         '退職年月日
    Dim i As Integer                '整数型カウンタ
    Dim intMsg As Integer           'メッセージの戻り値
    
    'カレントレコードの再取得
    If mobjWS(0).Cells(1, 1).Value = "" Then
        mlngRow = 0
    Else
        mlngRow = mobjWS(0).Cells(65536, 1).End(xlUp).Row
    End If
    
    For i = 1 To 12
        Set objText = Controls("txtSyouyo" & CStr(i))
        If objText.Enabled = False Then objText.Enabled = True
    Next
    
    '外部キーの取得
    mlngFID = Me.lstSyain.List(Me.lstSyain.ListIndex, 0)
    '社員数の取得
    lngRow1 = mobjWS(2).Cells(65536, 1).End(xlUp).Row
    '扶養親族数の取得
    mobjWS(2).Activate
    lngRow2 = mobjWS(2).Range(Cells(1, 1), Cells(lngRow1, 1)).Find(mlngFID, Cells(lngRow1, 1), xlValues).Row
    
    For i = 14 To 26
        mintNinzu = mintNinzu + CInt(mobjWS(2).Cells(lngRow2, i).Value)
    Next
    mintNinzu = mintNinzu - CInt(mobjWS(2).Cells(lngRow2, 16).Value) '老年者無効
    
    '月額標準報酬額による社会保険料の取得
    mlngTeigaku = CLng(mobjWS(3).Cells(lngRow2, 3).Value) + CLng(mobjWS(3).Cells(lngRow2, 4).Value)
    '雇用形態区分の取得
    mintKeitai = CInt(mobjWS(2).Cells(lngRow2, 4).Value)
    '在職退職区分の取得
    mintZaisyoku = CInt(mobjWS(2).Cells(lngRow2, 6).Value)
    '退職者の評価
    If mintZaisyoku > 1 Then
        datKisyu = CDate(mobjWS(2).Cells(lngRow2, 8).Value)
        datTaisyoku = CDate(mobjWS(2).Cells(lngRow2, 9).Value)
        If datKisyu < datTaisyoku Then
            'If Now() > datTaisyoku Then GoTo TaisyokuErrorProc
            '退職者への対応
            If Now() > datTaisyoku Then
                intMsg = MsgBox("退職者です。" & vbCrLf & "入力を続けますか...", 32 + 4, "給与計算システム")
                If intMsg = 7 Then
                    For i = 0 To 3
                        Set mobjWS(i) = Nothing
                    Next
                    MsgBox "再入力ボタンをクリックして下さい。", 64 + 0, "給与計算システム"
                    cmdOK.Enabled = False
                    Exit Sub
                End If
            End If
        End If
    End If
    '支給日リストの取得
    Call GetDateList(mlngFID)
    
    'ファーカスを当てる
    With Me.txtDate
        If .Enabled = False Then .Enabled = True
        .SetFocus
    End With
    
    Set objText = Nothing
    
    Exit Sub
    
TaisyokuErrorProc:

    MsgBox "すでに退職しています。", 16 + 0, "給与計算システム"

End Sub

'フォーカスがあたったとき（日付）
Private Sub txtDate_Enter()

    With Me.txtDate
        .SelStart = 0
        .SelLength = Len(.Text)
        .TextAlign = 1
        .IMEMode = 3
        .BackColor = RGB(255, 255, 0)
        If .Text = "" Then .Text = Format$(Now, "yyyy,mm,dd")
    End With

End Sub

'フォーカスが外れたとき（日付）
Private Sub txtDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtDate
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "yyyy/mm/dd")
    End With
    
End Sub

'値が更新されたあと
Private Sub txtSyouyo1_AfterUpdate()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim lngSyakai As Long           '社会保険料
    Dim i As Integer                '整数型カウンタ
    
    'NULL値の検査
    If Me.txtSyouyo1.Text = "" Then Me.txtSyouyo1.Text = 0
    If Me.txtSyouyo1.Enabled = True Then
        '雇用保険料の計算
        If mintKubun < 2 Then Call CalculateKoyou
        '社会保険料の計算
        If mobjWS(1).Cells(2, 1).Value = 1 Then Call CalculateSyakai
        '社会保険料
        For i = 2 To 5
            Set objText = Controls("txtsyouyo" & CStr(i))
            lngSyakai = lngSyakai + CLng(objText.Text)
        Next
        '源泉所得税
        Call CalculateZei(mlngTeigaku, lngSyakai, mintNinzu)
        '差引
        Call CalculateKingaku
    End If

    Set objText = Nothing
    
End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo1_Enter()

    With Me.txtSyouyo1
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With
    
End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo1
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With
    
End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo10_Enter()

    With Me.txtSyouyo10
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo10_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo10
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo11_Enter()

    With Me.txtSyouyo11
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo11_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo11
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo12_Enter()

    With Me.txtSyouyo12
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo12_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo12
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'値が更新されたあと
Private Sub txtSyouyo2_AfterUpdate()

    'NULL値の検査
    If Me.txtSyouyo2.Text = "" Then Me.txtSyouyo2.Text = 0
    '差引
    If Me.txtSyouyo2.Enabled = True Then Call CalculateKingaku

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo2_Enter()

    With Me.txtSyouyo2
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo2
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'値が更新されたあと
Private Sub txtSyouyo3_AfterUpdate()

    'NULL値の検査
    If Me.txtSyouyo3.Text = "" Then Me.txtSyouyo3.Text = 0
    '差引
    If Me.txtSyouyo3.Enabled = True Then Call CalculateKingaku

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo3_Enter()

    With Me.txtSyouyo3
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo3_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo3
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'値が更新されたあと
Private Sub txtSyouyo4_AfterUpdate()

    'NULL値の検査
    If Me.txtSyouyo4.Text = "" Then Me.txtSyouyo4.Text = 0
    '差引
    If Me.txtSyouyo4.Enabled = True Then Call CalculateKingaku

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo4_Enter()

    With Me.txtSyouyo4
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo4_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo4
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'値が更新されたあと
Private Sub txtSyouyo5_AfterUpdate()

    'NULL値の検査
    If Me.txtSyouyo5.Text = "" Then Me.txtSyouyo5.Text = 0
    '差引
    If Me.txtSyouyo5.Enabled = True Then Call CalculateKingaku

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo5_Enter()

    With Me.txtSyouyo5
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo5_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo5
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'値が更新されたあと
Private Sub txtSyouyo6_AfterUpdate()

    'NULL値の検査
    If Me.txtSyouyo6.Text = "" Then Me.txtSyouyo6.Text = 0
    '差引
    If Me.txtSyouyo6.Enabled = True Then Call CalculateKingaku

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo6_Enter()

    With Me.txtSyouyo6
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo6_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo6
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'値が更新されたあと
Private Sub txtSyouyo7_AfterUpdate()

    'NULL値の検査
    If Me.txtSyouyo7.Text = "" Then Me.txtSyouyo7.Text = 0
    '差引
    If Me.txtSyouyo7.Enabled = True Then Call CalculateKingaku

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo7_Enter()

    With Me.txtSyouyo7
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo7_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo7
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'値が更新されたあと
Private Sub txtSyouyo8_AfterUpdate()

    'NULL値の検査
    If Me.txtSyouyo8.Text = "" Then Me.txtSyouyo8.Text = 0
    '差引
    If Me.txtSyouyo8.Enabled = True Then Call CalculateKingaku

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo8_Enter()

    With Me.txtSyouyo8
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo8_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo8
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'値が更新されたあと
Private Sub txtSyouyo9_AfterUpdate()

    'NULL値の検査
    If Me.txtSyouyo9.Text = "" Then Me.txtSyouyo9.Text = 0
    '差引
    If Me.txtSyouyo9.Enabled = True Then Call CalculateKingaku

End Sub

'フォーカスがあたったとき
Private Sub txtSyouyo9_Enter()

    With Me.txtSyouyo9
        .SelStart = 0
        .SelLength = Len(.Text)
        .BackColor = RGB(255, 255, 0)
        .TextAlign = 1
        .IMEMode = 3
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtSyouyo9_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtSyouyo9
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 1
        .Text = Format$(.Text, "#,##0")
    End With

End Sub

'フォームロード時
Private Sub UserForm_Initialize()

    '初期値
    Call NewData
    '社員リストを取得
    Call GetSyainList
    '項目の取得
    Call GetKoumoku

End Sub

'フォームが閉じるとき
Private Sub UserForm_Terminate()

    Dim i As Integer
    
    If IsEmpty(mobjWS) = True Then Erase mobjWS
    'オブゲクトの開放
    For i = 0 To 3
        Set mobjWS(i) = Nothing
    Next
    
End Sub

'ワークシートデータの取得
Private Sub GetData(ByVal lngPID As Long)

'引数[lngPID]：主キー
'引数[lngFID]：外部キーのリストインデクス

    Dim clsSyouyo As clsSalary      '給与クラス
    Dim A() As Variant              'データ
    Dim objText As MSForms.TextBox  'テキストボックス
    Dim lngRow As Long              'カレントレコード
    Dim i As Long                   '長整数型カウンタ
    
    ReDim A(24) As Variant      '配列再定義
    
    'レコードの取得
    If mobjWS(0).Cells(1, 1).Value = "" Then
        mlngRow = 0
    Else
        mlngRow = mobjWS(0).Cells(65536, 1).End(xlUp).Row
    End If

    '支給日ＩＤと一致するレコードの取得
    mobjWS(0).Activate
    lngRow = mobjWS(0).Range(Cells(1, 1), Cells(mlngRow, 1)).Find(lngPID, Cells(mlngRow, 1), xlValues).Row
    
    'カレントレコードの移動
    mlngRow = lngRow - 1
    
    '給与クラスのインスタンス
    Set clsSyouyo = New clsSalary
    'ワークシートの値の取得
    clsSyouyo.GetProperty mobjWS(0), mlngRow + 1, A(0), A(1), A(2), A(3), A(4), A(5), A(6), A(7), A(8), A(9), _
                        A(10), A(11), A(12), A(13), A(14), A(15), A(16), A(17), A(18), A(19), A(20), A(21), A(22), _
                        A(23), A(24)
    
    Me.txtDate.Text = Format$(A(3), "yyyy/mm/dd")
    
    'ダミーデータを無視
    Me.txtSyouyo1.Text = Format$(A(4), "#,##0")
    
    For i = 16 To 23
        If i > 11 Then
            Set objText = Controls("txtSyouyo" & CStr(i - 14))
            objText.Text = Format$(A(i), "#,##0")
        End If
    Next
    
    Call CalculateKingaku
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    'クラスの開放
    Set clsSyouyo = Nothing
    'オブジェクトの開放
    Set objText = Nothing
    
End Sub

'ワークシートへ書き出し
Private Sub LetData()

    Dim clsSyouyo As clsSalary          '給与クラス
    Dim objText As MSForms.TextBox      'テキストボックス
    Dim A() As Variant                  'データ格納
    Dim i As Integer                    '整数型カウンタ
    Const intNextIndex As Integer = 1   'インデックス自動附番
    
    ReDim A(24) As Variant    '配列再定義
    
    'フォームのデータを配列に格納
    '主キー
    If mlngRow > 0 Then
        A(0) = CLng(mobjWS(0).Cells(mlngRow, 1).Value) + intNextIndex
    ElseIf mlngRow = 0 Then
        A(0) = CLng(1)
    Else
        GoTo ErrorProc
    End If
    
    '空白テキストボックスのNULL値を回避
    For i = 1 To 12
        Set objText = Controls("txtSyouyo" & CStr(i))
        If objText.Text = "" Then objText.Text = 0
    Next

    A(1) = Me.lstSyain.List(Me.lstSyain.ListIndex, 0) '外部キー
    A(2) = mintSikyu
    A(3) = CDate(Me.txtDate.Text)
    A(4) = Me.txtSyouyo1.Text
    
    For i = 1 To 20
        If i < 12 Then
            A(i + 4) = 0 'ダミーデータ
        ElseIf i > 11 And i < 20 Then
            Set objText = Controls("txtSyouyo" & CStr(i - 10))
            A(i + 4) = CLng(objText.Text)
        ElseIf i < 19 Then
            A(i + 4) = 0
        Else
            Exit For
        End If
    Next
    
    '給与クラスのインスタンス
    Set clsSyouyo = New clsSalary
    
    'プロパティへ格納
    clsSyouyo.LetProperty mobjWS(0), mlngRow + 1, A(0), A(1), A(2), A(3), A(4), A(5), A(6), A(7), A(8), A(9), _
                        A(10), A(11), A(12), A(13), A(14), A(15), A(16), A(17), A(18), A(19), A(20), A(21), _
                        A(22), A(23), A(24)
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    'クラスの開放
    Set clsSyouyo = Nothing
    'オブジェクトの開放
    Set objText = Nothing
    
    Exit Sub
    
ErrorProc:

    MsgBox "社員が選択されていません。" & vbCrLf & "社員リストから選択して下さい。", 48 + 0, "給与計算システム"
    
End Sub

'社会保険料計算
Private Sub CalculateSyakai()
'賞与の標準報酬額は、千円未満切り捨て
'円未満の端数処理は、51銭が切り上げ、50銭が切り捨て
'満40歳以上は介護費用保険が必要

 '   Const dblKenkou As Double = 0.041   '健康保険料率
 '   Const dblNenkin As Double = 0.07852  '厚生年金率---H21/9分以降
    Dim dblKenkou As Double             'H22/3分以降
    Dim dblNenkin As Double             'H22/3分以降
    
    Const dblKaigo As Double = 0.0075 '介護費用率---H22/3分以降
    Dim dblHyojun As Double             '標準賞与額
    Dim dblKenkougaku As Double         '健康保険料
    Dim dblNenkingaku As Double         '厚生年金額
    Dim dblKaigogaku As Double          '介護保険料額
    Const dblTeisu As Double = 0.9      '切り上げ定数
    Const dblRokunyu As Double = 0.4    '五捨六入定数
    Const dblHyojungaku As Double = 1000 '標準報酬額のまるめ桁
    Const dblHantei As Double = 10      '切り上げ判定桁
    Dim datNow As Date                  '現在の日付
    Dim datBirth As Date                '生年月日
    Dim intNenrei As Integer            '満年齢
    Dim clsTosi As clsNenrei            '年齢計算クラス---edit at 2004/12/30
    
    Set clsTosi = New clsNenrei
    dblHyojun = Int(CDbl(Me.txtSyouyo1.Text) / dblHyojungaku) * dblHyojungaku

    '健康保険料率取得
    If mobjWS(1).Cells(2, 4).Value <> "" Then dblKenkou = CDbl(mobjWS(1).Cells(2, 4).Value / 200)
    If mobjWS(1).Cells(2, 5).Value <> "" Then dblNenkin = CDbl(mobjWS(1).Cells(2, 5).Value / 200)
    
    If mintKeitai < 3 Then
        datNow = CDate(Me.txtDate.Text)
        datBirth = CDate(Me.lstSyain.List(Me.lstSyain.ListIndex, 3))
        '満年齢計算
        Call clsTosi.GetData(datBirth, datNow)
        intNenrei = clsTosi.Nenrei
        dblKenkougaku = Int(((dblHyojun * dblKenkou * dblHantei) + dblTeisu) / dblHantei + dblRokunyu)
        dblNenkingaku = Int(((dblHyojun * dblNenkin * dblHantei) + dblTeisu) / dblHantei + dblRokunyu)
        dblKaigogaku = Int(((dblHyojun * dblKaigo * dblHantei) + dblTeisu) / dblHantei + dblRokunyu)
        '40歳未満
        If intNenrei < 40 Then
            dblKaigogaku = 0
        '65歳以上
        ElseIf intNenrei > 64 Then
            dblNenkingaku = 0
            dblKaigogaku = 0
        End If
        Me.txtSyouyo2.Text = Format$(dblKenkougaku, "#,##0")
        Me.txtSyouyo3.Text = Format$(dblNenkingaku, "#,##0")
        Me.txtSyouyo4.Text = Format$(dblKaigogaku, "#,##0")
    End If
    'クラス開放
    Set clsTosi = Nothing
    
End Sub

'雇用保険計算
Private Sub CalculateKoyou()

    Dim clsKoyouHoken As clsKoyou   '雇用保険クラス
    Dim datNow As Date              '現在の日付
    Dim datBirth As Date            '生年月日
    Dim intNenrei As Integer        '満年齢
    Dim clsTosi As clsNenrei        '年齢計算クラス
    
    '雇用形態の検査
    If mintKeitai = 0 Or mintKeitai = 3 Then Exit Sub
    '雇用保険クラスのインスタンス
    Set clsKoyouHoken = New clsKoyou
    '年齢計算----- by at 2004/12/30
    Set clsTosi = New clsNenrei
    datNow = CDate(Me.txtDate.Text)
    datBirth = CDate(Me.lstSyain.List(Me.lstSyain.ListIndex, 3))
    Call clsTosi.GetData(datBirth, datNow)
    intNenrei = clsTosi.Nenrei
    
    If intNenrei > 65 And Month(datNow) > 3 Then
        Me.txtSyouyo5.Text = Format$(0, "#,##0")
    Else
        '計算結果をテキストボックスへ書き出し
        clsKoyouHoken.CalculateHoken CLng(Me.txtSyouyo1.Text), mintKubun, mintSikyu
        Me.txtSyouyo5.Text = Format$(clsKoyouHoken.KoyouHoken, "#,##0")
    End If
    'クラスの開放
    Set clsKoyouHoken = Nothing
    Set clsTosi = Nothing
    
End Sub

'源泉所得税の計算
Private Sub CalculateZei(ByVal lngTeigaku As Long, ByVal lngSyakai As Long, ByVal mintNinzu As Integer)

'引数[lngTeigaku]：月額標準報酬額による社会保険料
'引数[lngSyakai]：社会保険料
'引数[mintNinzu]：扶養親族数

    Dim clsZei As clsBonus  '源泉所得税クラス
    Dim f As Integer        '甲乙区分フラグ
    
    '在職の検査
    '退職者への対応
    'If mintZaisyoku > 0 Then GoTo ZaisyokuErrorProc
    '甲乙欄の取得
    f = Me.lstSyain.List(Me.lstSyain.ListIndex, 2)
    '源泉所得税クラスのインスタンス
    Set clsZei = New clsBonus
    
    If f = 0 Then   '甲欄
        '計算結果をテキストボックスへ
        clsZei.CalculateZei CLng(Me.txtSyouyo1.Text), lngTeigaku, lngSyakai, mintNinzu
        Me.txtSyouyo6.Text = Format$(clsZei.Zei, "#,##0")
    ElseIf f = 1 Then
        '計算結果をテキストボックスへ
        clsZei.CalculateZei2 CLng(Me.txtSyouyo1.Text), lngTeigaku, lngSyakai
        Me.txtSyouyo6.Text = Format$(clsZei.Zei, "#,##0")
    Else
        Me.txtSyouyo6.Text = 0
    End If
    
    'クラスの開放
    Set clsZei = Nothing
    
    Exit Sub
    
ZaisyokuErrorProc:

    MsgBox "退職者です。", 16 + 0, "給与計算システム"
    
End Sub

'集計
Private Sub CalculateKingaku()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim A() As Long                 'データ
    Dim i As Integer                '整数型カウンタ
    
    ReDim A(1) As Long        '配列再定義
        
    'テキストボックスのデータを取得
    For i = 1 To 9
        Set objText = Me.Controls("txtSyouyo" & CStr(i))
        If i < 2 Then A(0) = A(0) + CLng(objText.Text)
        If i > 1 Then A(1) = A(1) + CLng(objText.Text)
    Next
    
    With Me
        .txtSyouyo10.Text = Format$(A(0), "#,#0")
        .txtSyouyo11.Text = Format$(A(1), "#,##0")
        .txtSyouyo12 = Format$(A(0) - A(1), "#,##0")
    End With
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    'オブジェクトの開放
    Set objText = Nothing
    
End Sub

'支給年月日取得
Private Sub GetDateList(ByVal lngID As Long)

'引数[]：外部キー（社員コード）

    Dim clsDateID() As clsList      '支給年月日クラス
    Dim rngArea As Excel.Range            '外部キーエリア
    Dim lngRow As Long              'レコード数の取得
    Dim A() As Variant              'データ
    Dim intKisyu As Integer         '期首年月日
    Dim intTarget As Integer        '対象年月日
    Dim i As Long                   '長整数型カウンタ
    Dim j As Long                   '長整数型カウンタ
    Dim k As Long                   '配列の要素数
    
    '給与データの有無
    If Me.lstDate.ListIndex <> -1 And mobjWS(0).Cells(1, 1).Value = "" Then GoTo BlankProc
    '期首年月日の取得
    intKisyu = Year(CDate(mobjWS(1).Cells(3, 1).Value))
    
    '外部キーの数
    On Error GoTo ErrorProc
    mobjWS(0).Activate
    'レコード数の取得
    lngRow = mobjWS(0).Cells(65536, 1).End(xlUp).Row
    If lngRow < mlngRow Then lngRow = mlngRow
    Set rngArea = mobjWS(0).Range(Cells(1, 2), Cells(lngRow, 2))
    k = Application.WorksheetFunction.CountIf(rngArea, lngID)
    
    ReDim clsDateID(k - 1) As clsList   'クラス再定義
    ReDim A(k - 1, 1) As Variant        '配列再定義
    
    j = 0
    For i = 0 To mlngRow - 1
        '支給年月日及び支給区分の検査
        If mobjWS(0).Cells(i + 1, 2).Value = lngID And mobjWS(0).Cells(i + 1, 3).Value = mintSikyu Then
            intTarget = Year(CDate(mobjWS(0).Cells(i + 1, 4).Value))
            '支給範囲の検査
            If intTarget = intKisyu Then
                '支給年月日クラスのインスタンス
                Set clsDateID(j) = New clsList
                clsDateID(j).GetData2 mobjWS(0), i + 1, 1, 3, -1
                '配列に格納
                A(j, 0) = clsDateID(j).id
                A(j, 1) = Format$(clsDateID(j).Hiduke, "yyyy/mm/dd")
                j = j + 1
            End If
        End If
    Next
        
    With Me.lstDate
        .Clear
        .ColumnCount = 2
        .List() = A
    End With
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    'クラスの開放
    For i = 0 To k - 1
        Set clsDateID(i) = Nothing
    Next
    'オブジェクトの開放
    Set rngArea = Nothing
    
    On Error GoTo 0
    Exit Sub
    
BlankProc:

    MsgBox "訂正できる給与データはありません。" & vbCrLf & "給与データを入力して下さい。", 48 + 0, "給与計算システム"
    
    Exit Sub
    
ErrorProc:

    With Me.lstDate
        .Clear
        .ListIndex = -1
    End With

End Sub

'社員リストの取得
Private Sub GetSyainList()
    
    Dim clsSyainID() As clsList     '社員リストクラス
    Dim A() As Variant              'データ
    Dim lngRow As Long              '社員データ数
    Dim i As Long                   '長整数型カウンタ
    Dim j As Long                   '配列要素数
    
    '社員リストの有無
    If mobjWS(2).Cells(1, 1).Value = "" Then GoTo BlankProc
    
    '配列要素数の取得
    lngRow = mobjWS(2).Cells(65536, 1).End(xlUp).Row
    '退職の検査
    For i = 1 To lngRow
        'If mobjWS(2).Cells(i, 6).Value = 0 Then j = j + 1
        '退職者も含める
        j = j + 1
    Next
    '要素がないとき
    If j < 1 Then Exit Sub
    
    ReDim clsSyainID(j - 1) As clsList  'クラス再定義
    ReDim A(j - 1, 3) As Variant        '配列再定義
    
    j = 0
    For i = 0 To lngRow - 1
        '退職者も含める
        'If mobjWS(2).Cells(i + 1, 6).Value = 0 Then
            '社員リストクラスのインスタンス
            Set clsSyainID(j) = New clsList
            '社員リストの取得
            clsSyainID(j).GetData3 mobjWS(2), i + 1, 1, 2, 27, 7
            '配列に格納
            A(j, 0) = clsSyainID(j).id
            A(j, 1) = clsSyainID(j).Name
            A(j, 2) = clsSyainID(j).Number
            A(j, 3) = clsSyainID(j).Hiduke
            j = j + 1
        'End If
    Next
    
    With Me.lstSyain
        .Clear
        .ColumnCount = 4
        .List() = A
    End With
    
    If IsEmpty(A) = True Then Erase A
    
    'クラスの開放
    For i = 0 To j - 1
        Set clsSyainID(i) = Nothing
    Next
    
    Exit Sub
    
BlankProc:

    MsgBox "社員リストは空です。" & vbCrLf & "先に社員給与計算システムを登録して下さい。", 48 + 0, "給与計算システム"
        
End Sub

'項目の取得
Private Sub GetKoumoku()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim objLB As MSForms.Label      'ラベル
    Dim i As Integer                '整数型カウンタ
    
    '項目の取得
    For i = 1 To 3
        Set objLB = Controls("lblSyouyo" & CStr(i + 6))
        Set objText = Controls("txtSyouyo" & CStr(i + 6))
        If mobjWS(1).Cells(5, i).Value <> "" Then
            With objLB
                .Caption = mobjWS(1).Cells(5, i).Value & " ："
                .TextAlign = 3
            End With
            objText.Visible = True
        Else
            objText.Visible = False
        End If
    Next
    
    Set objText = Nothing
    Set objLB = Nothing
    
End Sub

'初期値設定
Public Sub NewData()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim objLB As MSForms.Label      'ラベル
    Dim i As Integer                '整数型カウンタ
    
    ReDim mobjWS(3) As Worksheet    '配列再定義
    
    'データワークシートの取得
    Set mobjWS(0) = Workbooks(gstrName).Worksheets("Sheet5")    '給与データ
    Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet1")    '雇用保険区分
    Set mobjWS(2) = Workbooks(gstrName).Worksheets("Sheet2")    '社員情報
    Set mobjWS(3) = Workbooks(gstrName).Worksheets("Sheet4")    '社員別社会保険
    
    'モジュールレベル変数の初期化
    mlngFID = 0
    mintNinzu = 0
    mlngRow = 0
    mlngTeigaku = 0
    mintKenkou = 0
    mintKeitai = 0
    mintKubun = 0
    mintZaisyoku = 0

    'レコードの取得
    If mobjWS(0).Cells(1, 1).Value = "" Then
        mlngRow = 0
    Else
        mlngRow = mobjWS(0).Cells(65536, 1).End(xlUp).Row
    End If
    
    '政府管掌健康保険加入区分
    If mobjWS(1).Cells(2, 1).Value = 1 Then mintKenkou = 1
    If mobjWS(1).Cells(2, 1).Value = 0 Then mintKenkou = 0
    '雇用保険区分の取得
    If mobjWS(1).Cells(2, 2).Value = 1 Then mintKubun = mobjWS(1).Cells(2, 3).Value
    If mobjWS(1).Cells(2, 2).Value = 0 Then mintKubun = 2
    
    For i = 1 To 12
        'ラベルコントロール
        Set objLB = Me.Controls("lblSyouyo" & CStr(i))
        If objLB.Caption <> "" Then objLB.TextAlign = 3
        
        'テキストボックスコントロール
        Set objText = Me.Controls("txtSyouyo" & CStr(i))
        'NULL値回避
        With objText
            .Text = CLng(0)
            .TextAlign = 3
            .Enabled = False
        End With
    Next
    
    With Me.txtDate
        .Text = Format$(Now, "yyyy/mm/dd")
        .Enabled = False
    End With
    
    Me.lblDate.TextAlign = 3
    Me.cmdDelete.Enabled = False
    
    '支給日リスト
    With Me.lstDate
        .Clear
        .ColumnWidths = "0;72"
        .ListIndex = -1
        .IMEMode = 3
    End With
    
    '社員リスト
    With Me.lstSyain
        .Clear
        .ColumnWidths = "0;72;0;0"
        .ListIndex = -1
        .IMEMode = 3
    End With
    
    Set objText = Nothing
    Set objLB = Nothing
    
End Sub