Option Explicit
'年末調整フォーム

Private mobjWS() As Worksheet
'mobjWS(0)：Sheet1：年度情報
'mobjWS(1)：Sheet2：社員情報
'mobjWS(2)：Sheet5：給与賞与情報
'mobjWS(3)：Sheet7：配偶者特別控情報
'mobjWS(4)：Sheet8：保険料控除等情報
'mobjWS(5)：Sheet9：前職分情報
'mobjWS(6)：Sheet10：年末調整資料
'mobjWS(7)：ThisWorkbook![Sheet5]：年末調整支援資料

Private mlngRID() As Long           'リレーションID
'mlngRID(0)：主キー
'mlbgRID(1)：社員ID
'mlbgRID(2)：配偶者特別控除ID
'mlngRID(3)：保険控除ID
'mlngRID(4)：前職分ID
'mlngRID(5)：住宅取得控除ID
'mlngRID(6)：甲乙区分

Private ma() As Variant             'データ
Private mlngKazei As Long           '課税給与
Private mlngSyakai As Long          '社会保険料
Private mlngZei As Long             '源泉所得税
Private mlngRow As Long             '要素数

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

    Unload Me
    
End Sub

'登録/計算ボタン
Private Sub cmdOK_Click()

    Dim intMsg As Integer   'メッセージの戻り値
    
    intMsg = MsgBox("計算しますか。", 32 + 4, "給与計算システム")
    
    If intMsg = 6 Then
        If IsNumeric(Me.txtNen.Text) = False Then GoTo ErrorProc
        Call NenmatuTyousei
        MsgBox "正常に計算しました。", 64 + 0, "給与計算システム"
    End If

    Exit Sub
    
ErrorProc:

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

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

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

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

    With Me.txtNen
        .BackColor = RGB(255, 255, 255)
        .TextAlign = 3
        .IMEMode = 0
    End With
    
End Sub

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

    Call NewData
    
End Sub

'フォームクローズ
Private Sub UserForm_Terminate()

    Dim i As Integer    '整数型カウンタ
        
    '配列の開放
    If IsEmpty(mobjWS) = True Then Erase mobjWS
    If IsEmpty(mlngRID) = True Then Erase mlngRID
    If IsEmpty(ma) = True Then Erase ma
    'オブジェクトの開放
    For i = 0 To 7
        Set mobjWS(i) = Nothing
    Next
    
End Sub


'年末調整
Private Sub NenmatuTyousei()

    Dim clsZei As clsNentyo   '年末調整クラス
    Dim clsSyain As clsList   '社員クラス
    Dim lngRow As Long          '社員数
    Dim i As Long               '長整数型カウンタ
    Dim j As Integer            '整数型カウンタ
    
    '社員数の取得
    lngRow = mobjWS(1).Cells(65536, 1).End(xlUp).Row
            
    For i = 0 To lngRow - 1
        If i < lngRow - 1 Then
            Me.lblMsg2.Caption = i + 1 & "/" & lngRow & Chr(32) & "処理中です..."
        Else
            Me.lblMsg2.Caption = i + 1 & "/" & lngRow & Chr(32) & "処理しました..."
        End If
        'クラスのインスタンス
        Set clsZei = New clsNentyo
        Set clsSyain = New clsList
        '社員情報の取得
        clsSyain.GetData mobjWS(1), i + 1, 1, 1, 25
        'データの取得
        Call GetData(clsSyain.id)
        '甲乙区分を渡す
        mlngRID(4) = clsSyain.Number
        clsZei.LetData mobjWS(6), mobjWS(1), mobjWS(3), mobjWS(4), mobjWS(5), i + 1, i + 1, _
                            mlngRID(0), mlngRID(1), mlngRID(2), mlngRID(3), CInt(mlngRID(4)), _
                            mlngKazei, mlngSyakai, mlngZei
        
        DoEvents
        '変数の初期化
        mlngKazei = 0
        mlngSyakai = 0
        mlngZei = 0
    
        For j = 0 To 24
            If j < 5 Then
                mlngRID(j) = 0
                ma(j) = 0
            Else
                ma(j) = 0
            End If
        Next
        'クラスの開放
        Set clsZei = Nothing
        Set clsSyain = Nothing
    Next
    
    '配列の開放(初期化)
    If IsEmpty(ma) = True Then Erase ma
    If IsEmpty(mlngRID) = True Then Erase mlngRID
    
End Sub

'集計
Private Sub SalarySum()

    Dim i As Integer            '整数型カウンタ
    
    '変数の初期化
    mlngKazei = 0
    mlngSyakai = 0
    mlngZei = 0

    '課税給与の集計
    For i = 0 To 10
        mlngKazei = mlngKazei + ma(i + 4)
    Next
    
    '社会保険料の集計
    For i = 0 To 3
        mlngSyakai = mlngSyakai + ma(i + 16)
    Next
    
    '源泉所得税の集計と他の合計
    mlngZei = mlngZei + ma(20)
        
End Sub

'データの取得
Private Sub GetData(ByVal lngID As Long)

'引数[lngID]：社員ID

    Dim clsSyunyu As clsSalary  '給与賞与クラス
    Dim intYear As Integer      '対象年
    Dim lngRow1 As Long         '開始レコード
    Dim lngRow2 As Long         '終了レコード
    Dim i As Long               '長整数型カウンタ
    Dim j As Long               '長整数型カウンタ
    Dim k As Long               '各要素数
    Dim r As Long               'カレントレコード
    
    '対象年の取得
    intYear = CInt(Me.txtNen.Text)
    
    '開始レコードを取得
    i = 1
    If Year(CDate(mobjWS(2).Cells(i, 4).Value)) = intYear Then
        lngRow1 = 1
    Else
        Do Until Year(CDate(mobjWS(2).Cells(i, 4).Value)) = intYear
            i = i + 1
        Loop
        lngRow1 = i
    End If
    
    '終了レコードの取得
    i = lngRow1
    If mobjWS(2).Cells(i + 1, 4).Value = "" Then
        lngRow2 = lngRow1
    Else
        Do Until Year(CDate(mobjWS(2).Cells(i, 4).Value)) <> intYear
            i = i + 1
        Loop
        lngRow2 = i
    End If

    '要素数の取得
    mobjWS(2).Activate
    k = Application.WorksheetFunction.CountIf(mobjWS(2).Range(Cells(lngRow1, 2), Cells(lngRow2, 2)), lngID)
    '配列再定義
    ReDim mlngRID(4) As Long
    ReDim ma(24) As Variant
    '要素がないとき
    If k < 1 Then GoTo BlankProc
    'NULL値回避
    For i = 0 To 4
        mlngRID(i) = 0
    Next
    
    On Error Resume Next
    '社員ID取得
    j = 0
    r = 0
    mlngRID(0) = lngID
    '配偶者特別控除ID取得
    If mobjWS(3).Cells(1, 1).Value <> "" Then
        j = mobjWS(3).Cells(65536, 1).End(xlUp).Row
        mobjWS(3).Activate
        r = mobjWS(3).Range(Cells(1, 2), Cells(j, 2)).Find(lngID, Cells(j, 2), xlValues).Row
        If r > 0 Then mlngRID(1) = CLng(mobjWS(3).Cells(r, 1).Value)
        j = 0
        r = 0
    End If
    '保険料控除ID取得/住宅取得
    If mobjWS(4).Cells(1, 1).Value <> "" Then
        j = mobjWS(4).Cells(65536, 1).End(xlUp).Row
        mobjWS(4).Activate
        r = mobjWS(4).Range(Cells(1, 2), Cells(j, 2)).Find(lngID, Cells(j, 2), xlValues).Row
        If r > 0 Then mlngRID(2) = CLng(mobjWS(4).Cells(r, 1).Value)
        j = 0
        r = 0
    End If
    '前職分ID取得
    If mobjWS(5).Cells(1, 1).Value <> "" Then
        j = mobjWS(5).Cells(65536, 1).End(xlUp).Row
        mobjWS(5).Activate
        r = mobjWS(5).Range(Cells(1, 2), Cells(j, 2)).Find(lngID, Cells(j, 2), xlValues).Row
        If r > 0 Then mlngRID(3) = CLng(mobjWS(5).Cells(r, 1).Value)
        j = 0
        r = 0
    End If
    
    j = 1
    Do While intYear = Year(CDate(mobjWS(2).Cells(j, 4).Value))
        If lngID = CInt(mobjWS(2).Cells(j, 2).Value) Then
            'クラスのインスタンス
            Set clsSyunyu = New clsSalary
            clsSyunyu.GetProperty mobjWS(2), j, ma(0), ma(1), ma(2), ma(3), ma(4), ma(5), ma(6), ma(7), _
                                    ma(8), ma(9), ma(10), ma(11), ma(12), ma(13), ma(14), ma(15), ma(16), _
                                    ma(17), ma(18), ma(19), ma(20), ma(21), ma(22), ma(23), ma(24)
            
            '集計
            Call SalarySum
            'クラスの開放
            Set clsSyunyu = Nothing
        End If
        j = j + 1
    Loop
    
    Exit Sub
    
BlankProc:
    
    '変数を初期化
    mlngKazei = 0
    mlngSyakai = 0
    mlngZei = 0
    
    For i = 0 To 24
        If i < 5 Then
            mlngRID(i) = 0
            ma(i) = 0
        Else
            ma(i) = 0
        End If
    Next
    '社員IDのみ渡す
    mlngRID(0) = lngID
    
End Sub

'既定値
Private Sub NewData()

    Dim objLB As MSForms.Label  'ラベル
    Dim i As Integer            '整数型カウンタ
    
    '配列再定義
    ReDim mobjWS(7) As Worksheet
    
    'ワークシート
    Set mobjWS(0) = Workbooks(gstrName).Worksheets("Sheet1")
    Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet2")
    Set mobjWS(2) = Workbooks(gstrName).Worksheets("Sheet5")
    Set mobjWS(3) = Workbooks(gstrName).Worksheets("Sheet7")
    Set mobjWS(4) = Workbooks(gstrName).Worksheets("Sheet8")
    Set mobjWS(5) = Workbooks(gstrName).Worksheets("Sheet9")
    Set mobjWS(6) = Workbooks(gstrName).Worksheets("Sheet10")
    Set mobjWS(7) = ThisWorkbook.Worksheets("Sheet5")
    
    'ラベル
    For i = 1 To 2
        Set objLB = Controls("lblKomoku" & CStr(i))
        objLB.TextAlign = 3
    Next
    With Me.lblMsg1
        .SpecialEffect = 2
        .Caption = "西暦" & Chr(32) & Chr(32) & Format$(mobjWS(0).Cells(3, 1).Value, "yyyy") & Chr(32) & "年"
        .TextAlign = 3
    End With
    
    'テキストボックス
    Me.txtNen.Text = Format$(Now(), "yyyy")
    
    Set objLB = Nothing
    
End Sub