Option Explicit
'雇用保険確定申告支援資料フォーム

Private mobjWS() As Worksheet   'ワークシート
'mobjWS(0)：ThisWorkbook：Sheet7
'mobjWS(1)：Sheet1：基礎情報
'mobjWS(2)：Sheet2：社員情報
'mobjWS(3)：Sheet5：給与賞与情報
Private mclsKyuyo As clsSalary  '給与賞与クラス
Private mclsSyain() As clsList  '社員クラス
Private mclsRoudo As clsRoudo   '労働保険クラス
Private ma() As Variant         'データ
Private mb() As Variant         'データ
Private mlngRow As Long         '社員数

'集計ボタン
Private Sub cmdCalc_Click()

    If IsNumeric(Me.txtNen2.Text) = False Then GoTo ErrorProc
    If Me.cmdOK.Enabled = True Then Me.cmdOK.Enabled = False
    If Me.cmdCalc.Enabled = True Then Me.cmdCalc.Enabled = False

    Call SyainList
    Call Syukei
    
    Me.lblMsg.Caption = "準備が整いました..."
    If Me.cmdOK.Enabled = False Then Me.cmdOK.Enabled = True
    Me.cmdOK.Caption = "印刷"
    
    Exit Sub
    
ErrorProc:

    MsgBox "入力値が不正です。", 16 + 0, "給与計算システム"
    
    Call NewData
    
    With Me.txtNen2
        .SelStart = 0
        .SelLength = Len(.Text)
        .SetFocus
    End With
    
End Sub

'Cancelボタン
Private Sub cmdOK_Click()

    Unload Me
    
    If Me.cmdOK.Caption = "印刷" Then Call mdlPrint.PrintKoyou
    
End Sub

'フォーカスが当ったとき
Private Sub txtNen1_Enter()

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

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

    With Me.txtNen1
        .IMEMode = 0
        .BackColor = RGB(255, 255, 255)
    End With
        
End Sub

'何か入力されたとき
Private Sub txtNen1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If Me.txtNen2.Text <> "" Then Me.cmdCalc.Enabled = True
    
End Sub

'フォーカスが当ったとき
Private Sub txtNen2_Enter()

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

End Sub

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

    With Me.txtNen2
        .IMEMode = 0
        .BackColor = RGB(255, 255, 255)
    End With
    
    Me.txtNen2.SetFocus
    
End Sub

'何か入力されたとき
Private Sub txtNen2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    If Me.txtNen1.Text <> "" Then Me.cmdCalc.Enabled = True
    
End Sub

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

    Call NewData
    
End Sub

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

    Dim i As Integer    '整数型カウンタ
    Dim j As Long       '長整数型カウンタ
    
    '配列の開放
    If IsEmpty(ma) = True Then Erase ma
    If IsEmpty(mb) = True Then Erase mb
    'クラスの開放
    Set mclsKyuyo = Nothing
    Set mclsRoudo = Nothing
    For i = 0 To 1
        For j = 0 To mlngRow - 1
            Set mclsSyain(i, j) = Nothing
        Next
    Next
    'オブジェクトの開放
    For i = 0 To 3
        Set mobjWS(i) = Nothing
    Next
    
End Sub

'集計
Private Sub Syukei()

    Dim c() As Long                 'データ
    Dim d() As Long                 'データ
    Dim intNen1 As Integer          '開始年
    Dim intNen2 As Integer          '終了年
    Dim intTuki As Integer          '対象月
    Dim intKubun As Integer         '雇用区分
    Dim intSikyu As Integer         '支給区分
    Dim intAge As Integer           '年齢
    Dim lngFID As Long              '社員ID
    Dim lngRow As Long              'データ数
    Dim lngRow1 As Long             '開始レコード
    Dim lngRow2 As Long             '終了レコード
    Dim i As Long                   '長整数型カウンタ
    Dim j As Long                   '長整数型カウンタ
    Dim k As Long                   '長整数型カウンタ
    Const intNenrei As Integer = 60 '老人年齢
    
    '配列再定義
    ReDim c(2, 16) As Long
    
    intNen1 = CInt(Me.txtNen1.Text)
    intNen2 = CInt(Me.txtNen2.Text)
    '対象データのレコード取得
    lngRow = mobjWS(3).Cells(65536, 1).End(xlUp).Row
    lngRow1 = 0
    lngRow2 = 0
    For i = 1 To lngRow
        If lngRow1 = 0 And intNen1 = Year(CDate(mobjWS(3).Cells(i, 4).Value)) Then
            lngRow1 = i
        ElseIf lngRow1 > i And intNen2 = Year(CDate(mobjWS(3).Cells(i, 4).Value)) Then
            lngRow2 = i
        End If
    Next

    '終了年エラーのとき
    If lngRow2 = 0 Then
        For i = 1 To lngRow
            If intNen1 = Year(CDate(mobjWS(3).Cells(i, 4).Value)) Then lngRow2 = i
        Next
    End If
    
    '集計
    k = 0
    For i = lngRow1 To lngRow2
        intTuki = Month(CDate(mobjWS(3).Cells(i, 4).Value))                         '支給月取得
        intSikyu = CInt(mobjWS(3).Cells(i, 3).Value)                                '支給形態取得
        lngFID = CLng(mobjWS(3).Cells(i, 2).Value)                                  '社員ID取得
        
        For j = 0 To mlngRow - 1
            If lngFID = mclsSyain(1, j).id Then
                intAge = CalculateAge(mclsSyain(1, j).Hiduke, intNen2)              '年齢取得
                Exit For
            End If
        Next
        
        For j = 0 To mlngRow - 1
            If lngFID = mclsSyain(0, j).id Then
                intKubun = mclsSyain(0, j).Number                                   '雇用形態
                Exit For
            End If
        Next
            
        If intSikyu = 0 Then                                                        '給与
            If intTuki > 3 Then Call KyuyoData(intNen1, intTuki, intKubun, k)       '4-12月
            If intTuki < 4 Then Call KyuyoData(intNen2, intTuki, intKubun, k)       '1-3月
            If intKubun > 0 Then Call GetData(mb(0) + mb(2), intTuki)
            mclsRoudo.DataSum
            mclsRoudo.RinjiSum
            mclsRoudo.RoujinSum
            c(0, intTuki - 1) = mclsRoudo.Goukei                                    '総合計
            If mclsSyain(0, k).Number > 1 Then c(1, intTuki - 1) = mclsRoudo.Rinji  '臨時合計
            If intAge >= intNenrei Then c(2, intTuki - 1) = mclsRoudo.Roujin        '老人合計
        ElseIf intSikyu = 1 Then                                                    '賞与
            If intTuki > 3 Then Call KyuyoData(intNen1, 13 + k, intKubun, k)        '4-12月
            If intTuki < 4 Then Call KyuyoData(intNen2, 13 + k, intKubun, k)        '1-3月
            If intKubun > 0 Then Call GetData(mb(0) + mb(2), intTuki)
            mclsRoudo.DataSum
            mclsRoudo.RinjiSum
            mclsRoudo.RoujinSum
            c(0, 12 + k) = mclsRoudo.Goukei                                         '総合計
            If mclsSyain(0, k).Number > 1 Then c(1, 12 + k) = mclsRoudo.Rinji       '臨時合計
            If intAge >= intNenrei Then c(2, 12 + k) = mclsRoudo.Roujin             '老人合計
            If intTuki <> Month(CDate(mobjWS(3).Cells(i, 4).Value)) Then k = k + 1
        End If
        
        Call BarPrint(lngRow2, i)
        DoEvents
    Next
    
    'データ書き出し
    For i = 0 To 16
        If i > 2 And i < 12 Then
            mobjWS(0).Cells(i + 2, 2).Value = Format$(c(0, i), "#,##0")
            mobjWS(0).Cells(i + 2, 3).Value = Format$(c(1, i), "#,##0")
            mobjWS(0).Cells(i + 2, 4).Value = Format$(c(0, i) + c(1, i), "#,##0")
            mobjWS(0).Cells(i + 2, 5).Value = Format$(c(0, i), "#,##0")
            mobjWS(0).Cells(i + 2, 6).Value = Format$(c(0, i), "#,##0")
            mobjWS(0).Cells(i + 2, 7).Value = Format$(c(2, i), "#,##0")
        ElseIf i < 3 Then
            mobjWS(0).Cells(i + 14, 2).Value = Format$(c(0, i), "#,##0")
            mobjWS(0).Cells(i + 14, 3).Value = Format$(c(1, i), "#,##0")
            mobjWS(0).Cells(i + 14, 4).Value = Format$(c(0, i) + c(1, i), "#,##0")
            mobjWS(0).Cells(i + 14, 5).Value = Format$(c(0, i), "#,##0")
            mobjWS(0).Cells(i + 14, 6).Value = Format$(c(0, i), "#,##0")
            mobjWS(0).Cells(i + 14, 7).Value = Format$(c(2, i), "#,##0")
        ElseIf i > 11 Then
            mobjWS(0).Cells(i + 5, 2).Value = Format$(c(0, i), "#,##0")
            mobjWS(0).Cells(i + 5, 3).Value = Format$(c(1, i), "#,##0")
            mobjWS(0).Cells(i + 5, 4).Value = Format$(c(0, i) + c(1, i), "#,##0")
            mobjWS(0).Cells(i + 5, 5).Value = Format$(c(0, i), "#,##0")
            mobjWS(0).Cells(i + 5, 6).Value = Format$(c(0, i), "#,##0")
            mobjWS(0).Cells(i + 5, 7).Value = Format$(c(2, i), "#,##0")
        End If
    Next
    
    '配列再定義
    ReDim d(2) As Long

    For i = 0 To 16
        d(0) = d(0) + c(0, i)
        d(1) = d(1) + c(1, i)
        d(2) = d(2) + c(2, i)
    Next
    
    '合計書き出し
    mobjWS(0).Cells(22, 2).Value = Format$(d(0), "#,##0")
    mobjWS(0).Cells(22, 3).Value = Format$(d(1), "#,##0")
    mobjWS(0).Cells(22, 4).Value = Format$(d(0) + d(1), "#,##0")
    mobjWS(0).Cells(22, 5).Value = Format$(d(0), "#,##0")
    mobjWS(0).Cells(22, 6).Value = Format$(d(0), "#,##0")
    mobjWS(0).Cells(22, 7).Value = Format$(d(2), "#,##0")
    
    If IsEmpty(c) = True Then Erase c
    If IsEmpty(d) = True Then Erase d
    
End Sub

'データの格納
Private Sub GetData(ByVal lngData As Long, ByVal intNum As Integer)

'引数[lngData]：データ
'引数[intNum]：月

    Select Case intNum
        Case Is = 1
            mclsRoudo.Jan = mclsRoudo.Jan + lngData
        Case Is = 2
            mclsRoudo.Feb = mclsRoudo.Feb + lngData
        Case Is = 3
            mclsRoudo.Mac = mclsRoudo.Mac + lngData
        Case Is = 4
            mclsRoudo.Apr = mclsRoudo.Apr + lngData
        Case Is = 5
            mclsRoudo.May = mclsRoudo.May + lngData
        Case Is = 6
            mclsRoudo.Jun = mclsRoudo.Jun + lngData
        Case Is = 7
            mclsRoudo.Jly = mclsRoudo.Jly + lngData
        Case Is = 8
            mclsRoudo.Aug = mclsRoudo.Aug + lngData
        Case Is = 9
            mclsRoudo.Sep = mclsRoudo.Sep + lngData
        Case Is = 10
            mclsRoudo.Oct = mclsRoudo.Oct + lngData
        Case Is = 11
            mclsRoudo.Nov = mclsRoudo.Nov + lngData
        Case Is = 12
            mclsRoudo.Dec = mclsRoudo.Dec + lngData
        Case Is = 13
            mclsRoudo.Bonus1 = mclsRoudo.Bonus1 + lngData
        Case Is = 14
            mclsRoudo.Bonus2 = mclsRoudo.Bonus2 + lngData
        Case Is = 15
            mclsRoudo.Bonus3 = mclsRoudo.Bonus3 + lngData
        Case Is = 16
            mclsRoudo.Bonus4 = mclsRoudo.Bonus4 + lngData
        Case Is = 17
            mclsRoudo.Bonus5 = mclsRoudo.Bonus5 + lngData
    End Select
    
End Sub

'給与賞与データの取得
Private Sub KyuyoData(ByVal intNen As Integer, ByVal intTuki As Integer, ByVal intKubun As Integer, ByVal Target As Long)

'引数[intNen]：対象年
'引数[intTuki]：対象月
'引数[intKubun]：支給区分
'引数[Target]：賞与書き出しレコード

    Dim lngRow As Long          'レコード
    Dim i As Long               '長整数型カウンタ
    Dim j As Long               'データ数
    Const lngAdd As Long = 17   '賞与レコード
    
    '配列再定義
    ReDim ma(24) As Variant
    ReDim mb(7) As Variant
    
    '対象デコードの取得
    j = mobjWS(3).Cells(65536, 1).End(xlUp).Row
    
    For i = 1 To j
        If intNen = Year(CDate(mobjWS(3).Cells(i, 4).Value)) Then
            If intKubun = 0 Then
                If intTuki = Month(CDate(mobjWS(3).Cells(i, 4).Value)) Then
                    lngRow = i
                    Exit For
                End If
            ElseIf intKubun > 0 Then
                lngRow = Target + lngAdd
                Exit For
            End If
        End If
    Next
    
    mclsKyuyo.GetProperty mobjWS(3), lngRow, 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)
        
    mclsKyuyo.DataSum mb(0), mb(1), mb(2), mb(3), mb(4), mb(5), mb(6), mb(7)
    
End Sub

'社員情報の取得
Private Sub SyainList()

    Dim i As Long   '長整数型カウンタ
    
    For i = 1 To mlngRow
        mclsSyain(0, i - 1).GetData mobjWS(2), i, 1, 1, 2
        mclsSyain(1, i - 1).GetData2 mobjWS(2), i, 1, 6, 0
    Next
    
End Sub

'進行状況の表示
Private Sub BarPrint(ByVal x As Long, ByVal y As Long)

'引数[x]：総数
'引数[y]：回数

    Const z As Integer = 200               'ラベルの長さ
    
    If x = 0 Or y = 0 Then
        x = 1
        y = 1
    End If

    Me.lblBar2.Width = Int(CDbl(z * (y / x)))
    Me.lblMsg.Caption = y & "/" & x & Chr(32) & "処理中..."
    
End Sub

'既定値
Private Sub NewData()

    Dim i As Integer    '整数型カウンタ
    Dim j As Long       '長整数型カウンタ
    
    '配列再定義
    ReDim mobjWS(3) As Worksheet
    'ワークシート
    Set mobjWS(0) = ThisWorkbook.Worksheets("Sheet7")
    Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet1")
    Set mobjWS(2) = Workbooks(gstrName).Worksheets("Sheet2")
    Set mobjWS(3) = Workbooks(gstrName).Worksheets("Sheet5")
    '社員数の取得
    mlngRow = mobjWS(2).Cells(65536, 1).End(xlUp).Row
    '配列再定義
    ReDim mclsSyain(1, mlngRow - 1) As clsList
    'クラスのシンスタンス
    Set mclsKyuyo = New clsSalary
    Set mclsRoudo = New clsRoudo
    For i = 0 To 1
        For j = 0 To mlngRow - 1
            Set mclsSyain(i, j) = New clsList
        Next
    Next
    
    With Me.lblBar2
        .Width = 0
        .BackColor = RGB(0, 0, 255)
    End With
    
    Me.cmdCalc.Enabled = False
    Me.cmdOK.Caption = "キャンセル"
    With Me.txtNen1
        .Text = Year(Now())
        .SetFocus
    End With
    
End Sub

'年齢計算
Private Function CalculateAge(ByVal datBirthDay As Date, ByVal intNen As Integer) As Integer

'引数[datBirthDay]：誕生日
'引数[intNen]：対象年

    Dim intKijun As Integer          '基準年月日
    
    CalculateAge = intNen - Year(datBirthDay)
    
End Function