Option Explicit
'配偶者特別控除計算フォーム

Private mobjWS() As Worksheet   'ワークシート
'mobjWS(0)：Sheet7：配偶者特別控除情報
'mobjWS(1)：Sheet2：社員情報
'mobjWS(2)：Sheet3：扶養親族情報

Private mlngRow As Long         'レコード

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

    Dim lngFID As Long  '外部キー（社員）
    
    '社員IDの取得
    lngFID = Me.lstSyain.List(Me.lstSyain.ListIndex, 0)
    '初期値に戻る
    Call NewData
    '社員リスト取得
    Call GetSyainList
    '家族リスト取得
    Call GetKazokuList(lngFID)
    
End Sub

'閉じるボタン
Private Sub cmdEND_Click()

    Unload Me
    
End Sub

'登録ボタン
Private Sub cmdOK_Click()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim lngFID1 As Long             '社員ID（外部キー）
    Dim lngFID2 As Long             '家族ID（外部キー）
    Dim intMsg As Integer           'メッセージ
    Dim i As Integer                '整数型カウンタ
    
    intMsg = MsgBox("登録しますか。", 32 + 4, "給与計算システム")
    
    If intMsg = 6 Then
        '外部キーの取得
        lngFID1 = Me.lstSyain.List(Me.lstSyain.ListIndex, 0)
        lngFID2 = Me.lstKazoku.List(Me.lstKazoku.ListIndex, 0)
        'NULL値の回避
        For i = 1 To 9
            Set objText = Controls("txtKingaku" & CStr(i))
            If objText.Text = "" Then objText.Text = 0
        Next
        'ワークシートに書き出し
        Call LetData(lngFID1, lngFID2)
        MsgBox "正常に登録しました。", 64 + 0, "給与計算シスてテム"
    End If
    
    Set objText = Nothing
    
End Sub

'家族リスト選択
Private Sub lstKazoku_Click()

    Dim lngFID1 As Long      '外部キー（社員ID）
    Dim lngFID2 As Long      '外部キー（家族ID）
    Dim lngRow As Long       'レコード
    
    'レコード数の再定義
    If mobjWS(0).Cells(1, 1).Value = "" Then
        mlngRow = 0
    Else
        mlngRow = mobjWS(0).Cells(65536, 1).End(xlUp).Row
    End If
    
    On Error GoTo ErrorProc
    '社員IDの取得
    lngFID1 = Me.lstSyain.List(Me.lstSyain.ListIndex, 0)
    If Me.lstKazoku.ListIndex = -1 Then Exit Sub
    '家族IDの取得
    lngFID2 = Me.lstKazoku.List(Me.lstKazoku.ListIndex, 0)
    'ワークシートデータの取得
    Call GetData(lngFID1, lngFID2)
    
    Exit Sub
    
ErrorProc:

    MsgBox "家族情報がありません。", 16 + 0, "給与計算システム"
    
End Sub

'社員リスト選択
Private Sub lstSyain_Click()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim lngID As Long               '社員ID（外部キー）
    Dim i As Integer                '整数型カウンタ
    
    'テキストボックスのアクセスを不許可
    For i = 1 To 9
        Set objText = Controls("txtKingaku" & CStr(i))
        If objText.Enabled = True Then objText.Enabled = False
    Next
    
    '外部キーの取得
    lngID = Me.lstSyain.List(Me.lstSyain.ListIndex, 0)
    '家族リスト取得
    Call GetKazokuList(lngID)
    Set objText = Nothing
    
End Sub

'値が変更されたあと
Private Sub txtKingaku1_AfterUpdate()

    If IsNumeric(Me.txtKingaku1.Text) = False Then GoTo ErrorProc

    '集計
    Call CalculateSyotoku
    
    Exit Sub
    
ErrorProc:

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

End Sub

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

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

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

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

'値が変更されたあと
Private Sub txtKingaku2_AfterUpdate()

    If IsNumeric(Me.txtKingaku2.Text) = False Then GoTo ErrorProc

    '集計
    Call CalculateSyotoku
    
    Exit Sub
    
ErrorProc:

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

End Sub

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

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

End Sub

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

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

End Sub

'値が変更されたあと
Private Sub txtKingaku3_AfterUpdate()

    If IsNumeric(Me.txtKingaku3.Text) = False Then GoTo ErrorProc

    '集計
    Call CalculateSyotoku
    
    Exit Sub
    
ErrorProc:

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

End Sub

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

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

End Sub

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

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

End Sub

'値が変更されたあと
Private Sub txtKingaku4_AfterUpdate()

    If IsNumeric(Me.txtKingaku4.Text) = False Then GoTo ErrorProc

    '集計
    Call CalculateSyotoku
    
    Exit Sub
    
ErrorProc:

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

End Sub

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

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

End Sub

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

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

End Sub

'値が変更されたあと
Private Sub txtKingaku5_AfterUpdate()

    If IsNumeric(Me.txtKingaku5.Text) = False Then GoTo ErrorProc

    '集計
    Call CalculateSyotoku
    
    Exit Sub
    
ErrorProc:

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

End Sub

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

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

End Sub

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

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

End Sub

'値が変更されたあと
Private Sub txtKingaku6_AfterUpdate()

    If IsNumeric(Me.txtKingaku6.Text) = False Then GoTo ErrorProc

    '集計
    Call CalculateSyotoku
    
    Exit Sub
    
ErrorProc:

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

End Sub

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

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

End Sub

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

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

End Sub

'値が変更されたあと
Private Sub txtKingaku7_AfterUpdate()

    If IsNumeric(Me.txtKingaku7.Text) = False Then GoTo ErrorProc

    '集計
    Call CalculateSyotoku
    
    Exit Sub
    
ErrorProc:

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

End Sub

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

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

End Sub

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

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

End Sub

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

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

End Sub

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

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

End Sub

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

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

End Sub

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

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

End Sub

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

    '初期値設定
    Call NewData
    '社員リスト
    Call GetSyainList
    
End Sub

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

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

'ワークシートの値の取得
Private Sub GetData(ByVal lngFID1 As Long, ByVal lngFID2 As Long)

'引数[lngFID1]：外部キー（社員）
'引数[lngFID2]：外部キー（家族）

    Dim clsKingaku() As clsNumber       '所得金額クラス
    Dim objText As MSForms.TextBox      'テキストボックス
    Dim lngRow1 As Long                 'レコード
    Dim lngRow2 As Long                 'レコード
    Dim i As Integer                    '整数型カウンタ
    
    ReDim clsKingaku(11) As clsNumber   '配列再定義

    On Error Resume Next
    '社員IDと家族IDと一致するレコードの検索
    mobjWS(0).Activate
    lngRow1 = mobjWS(0).Range(Cells(1, 2), Cells(mlngRow, 2)).Find(lngFID1, Cells(mlngRow, 2), xlValues).Row
    lngRow2 = mobjWS(0).Range(Cells(1, 3), Cells(mlngRow, 3)).Find(lngFID2, Cells(mlngRow, 3), xlValues).Row
    '両方が成立するとき
    If lngRow1 > 0 And lngRow2 < 1 Then GoTo ErrorProc
    'カレントレコードの移動
    If lngRow2 > 0 Then mlngRow = lngRow2 - 1

    For i = 0 To 11
        '所得金額クラスのインスタンス
        Set clsKingaku(i) = New clsNumber
        If i > 2 Then
            Set objText = Controls("txtKingaku" & CStr(i - 2))
            clsKingaku(i).GetData mobjWS(0), mlngRow + 1, i + 1
            objText.Text = Format$(clsKingaku(i).Number, "#,##0")
            If objText.Enabled = False Then objText.Enabled = True
        End If
    Next
    
    'クラスの開放
    For i = 0 To 11
        Set clsKingaku(i) = Nothing
    Next
    
    Set objText = Nothing
    
    Exit Sub
    
ErrorProc:

    MsgBox "すでに設定済みです。", 16 + 0, "給与計算システム"

    For i = 1 To 9
        Set objText = Controls("txtKingaku" & CStr(i))
        objText.Text = 0
        If objText.Enabled = True Then objText.Enabled = False
    Next
    
    Set objText = Nothing
    
End Sub

'ワークシートへ書き出し
Private Sub LetData(ByVal lngFID1 As Long, ByVal lngFID2 As Long)

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

    Dim clsKoujo() As clsNumber     '所得金額クラス
    Dim objText As MSForms.TextBox  'テキストボックス
    Dim i As Integer                '整数型カウンタ
    
    ReDim clsKoujo(11) As clsNumber  '配列再定義
    
    '所得金額クラスのインスタンス
    For i = 0 To 11
        Set clsKoujo(i) = New clsNumber
        
        If i = 0 Then
            clsKoujo(i).Number = CDbl(mlngRow + 1)
            clsKoujo(i).SetData mobjWS(0), mlngRow + 1, i + 1
        End If
        
        If i = 1 Then
            clsKoujo(i).Number = CDbl(lngFID1)
            clsKoujo(i).SetData mobjWS(0), mlngRow + 1, i + 1
        End If
        
        If i = 2 Then
            clsKoujo(i).Number = CDbl(lngFID2)
            clsKoujo(i).SetData mobjWS(0), mlngRow + 1, i + 1
        End If
        
        If i > 2 Then
            Set objText = Controls("txtKingaku" & CStr(i - 2))
            clsKoujo(i).Number = CDbl(objText.Text)
            clsKoujo(i).SetData mobjWS(0), mlngRow + 1, i + 1
        End If
    Next
    
    'クラスの開放
    For i = 0 To 11
        Set clsKoujo(i) = Nothing
    Next
    
    Set objText = Nothing
    
End Sub

'集計
Private Sub CalculateSyotoku()

    Dim clsKoujo As clsHaigusya     '配偶者特別控除クラス
    Dim objText As MSForms.TextBox  'テキストボックス
    Dim A As Long                   '一時データ
    Dim i As Integer                '整数型カウンタ
    
    '集計
    For i = 0 To 6
        'テキストボックス
        Set objText = Controls("txtKingaku" & CStr(i + 1))
        A = A + CLng(objText.Text)
        Me.txtKingaku8.Text = Format$(A, "#,##0")
    Next
    
    '配偶者特別控除クラスのインスタンス
    Set clsKoujo = New clsHaigusya
    '配偶者特別控除額の計算
    clsKoujo.CalculateKoujo CLng(Me.txtKingaku8.Text)
    'テキストボックスに表示
    Me.txtKingaku9.Text = Format$(clsKoujo.Koujo, "#,##0")
    
    'クラスの開放
    Set clsKoujo = Nothing
    'オブジェクトの開放
    Set objText = Nothing
    
End Sub

'家族リストの取得
Private Sub GetKazokuList(ByVal lngID As Long)

'引数[lngID]：社員リストＩＤ；外部キー

    Dim rngArea As Excel.Range            '外部キーエリア
    Dim clsKazokuID() As clsList    '家族リストクラス
    Dim lngRow As Long              'レコード数
    Dim A() As Variant              'データ
    Dim i As Long                   '長整数型カウンタ
    Dim j As Long                   '配列要素数
    
    '家族リストの有無
    If mobjWS(2).Cells(1, 1).Value = "" Then GoTo BlankProc
        
    '外部キーに該当する家族リスト数の取得
    mobjWS(2).Activate
    'レコード数の取得
    lngRow = mobjWS(2).Cells(65536, 1).End(xlUp).Row
    If lngRow < mlngRow Then lngRow = mlngRow
    
    Set rngArea = mobjWS(2).Range(Cells(1, 2), Cells(lngRow, 2))
    j = Application.WorksheetFunction.CountIf(rngArea, lngID)
    
    If j = 0 Then GoTo BlankProc
    
    ReDim clsKazokuID(j - 1) As clsList 'クラス再定義
    ReDim A(j - 1, 1) As Variant  '配列再定義
    
    j = 0
    For i = 1 To lngRow
        If mobjWS(2).Cells(i, 2).Value = lngID Then
            '家族リストクラスのインスタンス
            Set clsKazokuID(j) = New clsList
            '家族リストの取得
            clsKazokuID(j).GetData mobjWS(2), i, 1, 2, -1
            '配列に格納
            A(j, 0) = clsKazokuID(j).id
            A(j, 1) = clsKazokuID(j).Name
            j = j + 1
        End If
    Next
    
    With Me.lstKazoku
        .Clear
        .ColumnCount = 2
        .List() = A
        .ListIndex = -1
    End With
    
    If IsEmpty(A) = True Then Erase A
    
    'クラスの開放
    For i = 0 To j - 1
        Set clsKazokuID(i) = Nothing
    Next
    
    Set rngArea = Nothing
    
    Exit Sub
    
BlankProc:

    With Me.lstKazoku
        .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(1).Cells(1, 1).Value = "" Then GoTo BlankProc
    
    '配列要素数の取得
    lngRow = mobjWS(1).Cells(65536, 1).End(xlUp).Row
    '退職の検査
    j = 0
    For i = 1 To lngRow
        If mobjWS(1).Cells(i, 6).Value = 0 Then j = j + 1
    Next
    
    '要素がないとき
    If j < 1 Then Exit Sub
    
    ReDim clsSyainID(j - 1) As clsList    'クラス再定義
    ReDim A(j - 1, 1) As Variant    '配列再定義
    
    j = 0
    For i = 0 To lngRow - 1
        If mobjWS(1).Cells(i + 1, 6).Value = 0 Then
            '社員リストクラスのインスタンス
            Set clsSyainID(j) = New clsList
            '社員リストの取得
            clsSyainID(j).GetData mobjWS(1), i + 1, 1, 1, 4
            '配列に格納
            A(j, 0) = clsSyainID(j).id
            A(j, 1) = clsSyainID(j).Name
            j = j + 1
        End If
    Next
    
    With Me.lstSyain
        .Clear
        .ColumnCount = 2
        .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 NewData()

    Dim objText As MSForms.TextBox  'テキストボックス
    Dim objLB As MSForms.Label      'ラベル
    Dim i As Integer                '整数型カウンタ
    
    ReDim mobjWS(2) As Worksheet    '配列再定義
    
    'ワークシート
    Set mobjWS(0) = Workbooks(gstrName).Worksheets("Sheet7")
    Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet2")
    Set mobjWS(2) = Workbooks(gstrName).Worksheets("Sheet3")
    
    'レコードの取得
    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 9
        'ラベル
        Set objLB = Controls("lblKoumoku" & CStr(i))
        objLB.TextAlign = 3
        'テキストボックス
        Set objText = Controls("txtKingaku" & CStr(i))
        With objText
            .Text = 0
            .TextAlign = 3
            .Enabled = False
        End With
    Next
    
    '家族リスト
    With Me.lstKazoku
        .Clear
        .ColumnWidths = "0;72"
        .ListIndex = -1
        .IMEMode = 3
    End With
    
    '社員リスト
    With Me.lstSyain
        .Clear
        .ColumnWidths = "0;72"
        .ListIndex = -1
        .IMEMode = 3
    End With

    Set objText = Nothing
    Set objLB = Nothing
    
End Sub