Option Explicit
'賃金台帳集計フォーム

Private mobjWS() As Worksheet
'mobjWS(0)：ThisBooks.Sheet3
'mobjWS(1)：Sheet1：基本項目
'mobjWS(2)：Sheet2：社員情報
'mobjWS(3)：Sheet5：給与賞与情報

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

    Unload Me
    
End Sub

'集計ボタン
Private Sub cmdOK_Click()

    Dim lngPID As Long      '社員ID
    Dim lngRow As Long      'データ数
    Dim i As Long           '長整数型カウンタ
    Dim intMsg As Integer   'メッセージの戻り値
    
    '社員名の取得
    lngPID = Me.lstSyain.List(Me.lstSyain.ListIndex, 0)
    'カレントレコードの取得
    lngRow = mobjWS(3).Cells(65536, 1).End(xlUp).Row
    For i = 1 To lngRow
        If lngPID = CLng(mobjWS(3).Cells(i, 2).Value) Then
            Call MoveData(lngPID, i)
        End If
        Me.lblMsg2.Caption = "処理中です..."
        DoEvents
    Next
    
    Call GetKomoku
    Call DataSum
    Me.lblMsg2.Caption = "終了しました..."
    
    intMsg = MsgBox("正常に集計しました。" & vbCrLf & "続けて印刷しますか。", 32 + 4, "給与計算システム")
    
    If intMsg = 6 Then
        Unload Me
        Call mdlPrint.PrintTinginDaityou
    ElseIf intMsg = 7 Then
        mobjWS(0).Activate
        mobjWS(0).Range(Cells(4, 2).Cells(65536, 14)).Clear
    End If
    
End Sub

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

    If Me.cmdOK.Enabled = False Then Me.cmdOK.Enabled = True
    
End Sub

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

    Call NewData
    Call GetSyainList
    'H22.3.31
    Call NenList
    
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 GetKomoku()

    Dim i As Integer    '整数型カウンタ
    
    '給与項目
    For i = 1 To 10
        If i < 6 Then
            mobjWS(0).Cells(i + 9, 1).Value = mobjWS(1).Cells(4, i).Value
        Else
            mobjWS(0).Cells(i + 16, 1).Value = mobjWS(1).Cells(4, i).Value
        End If
    Next
    
    '賞与項目
    For i = 1 To 3
        mobjWS(0).Cells(i + 35, 1).Value = mobjWS(1).Cells(5, i).Value
    Next
    
End Sub

'合計額の計算
Private Sub DataSum()

    Dim lngData As Long 'データ
    Dim i As Integer    '整数型カウンタ
    Dim j As Integer    '整数型カウンタ
    
    lngData = 0
    '給与支給額の合計
    For i = 2 To 13
        For j = 4 To 15
            lngData = lngData + CLng(mobjWS(0).Cells(j, i).Value)
        Next
        With mobjWS(0).Cells(16, i)
            .Value = Format$(lngData, "#,##0")
            With .Interior
                .ColorIndex = 37
                .Pattern = xlSolid
            End With
        End With
        lngData = 0
    Next
    
    lngData = 0
    '給与控除額の合計
    For i = 2 To 13
        For j = 17 To 25
            lngData = lngData + CLng(mobjWS(0).Cells(j, i).Value)
        Next
        With mobjWS(0).Cells(26, i)
            .Value = Format$(lngData, "#,##0")
            With .Interior
                .ColorIndex = 37
                .Pattern = xlSolid
            End With
        End With
        lngData = 0
    Next
    
    '給与差引合計
    For i = 2 To 13
        With mobjWS(0).Cells(27, i)
            .Value = Format$(mobjWS(0).Cells(16, i).Value - mobjWS(0).Cells(26, i).Value, "#,##0")
            With .Interior
                .ColorIndex = 37
                .Pattern = xlSolid
            End With
        End With
    Next
    
    lngData = 0
    '賞与控除額の合計
    For i = 2 To 13
        For j = 31 To 38
            lngData = lngData + CLng(mobjWS(0).Cells(j, i).Value)
        Next
        With mobjWS(0).Cells(39, i)
            .Value = Format$(lngData, "#,##0")
            With .Interior
                .ColorIndex = 37
                .Pattern = xlSolid
            End With
        End With
        lngData = 0
    Next
    
    '賞与差引合計
    For i = 2 To 13
        With mobjWS(0).Cells(40, i)
            .Value = Format$(mobjWS(0).Cells(29, i).Value - mobjWS(0).Cells(39, i).Value, "#,##0")
            With .Interior
                .ColorIndex = 37
                .Pattern = xlSolid
            End With
        End With
    Next
    
    lngData = 0
    '年間合計
    For j = 4 To 40
        For i = 2 To 13
            lngData = lngData + CLng(mobjWS(0).Cells(j, i).Value)
        Next
        If j < 28 Then
            With mobjWS(0).Cells(j, 14)
                .Value = Format$(lngData, "#,##0")
                With .Interior
                    .ColorIndex = 37
                    .Pattern = xlSolid
                End With
            End With
        ElseIf j = 29 Then
            With mobjWS(0).Cells(j, 14)
                .Value = Format$(lngData, "#,##0")
                With .Interior
                    .ColorIndex = 37
                    .Pattern = xlSolid
                End With
            End With
        ElseIf j > 29 Then
            With mobjWS(0).Cells(j, 14)
                .Value = Format$(lngData, "#,##0")
                With .Interior
                    .ColorIndex = 37
                    .Pattern = xlSolid
                End With
            End With
        End If
        lngData = 0
    Next
    
End Sub

'データの移動
Private Sub MoveData(ByVal lngID As Long, ByVal lngRow As Long)

'引数[lngID]：社員ID
'引数[lngRow]：レコード

    Dim clsKyuyo As clsSalary   '給与賞与クラス
    Dim A() As Variant          'データ
    Dim strSyain As String      '社員名
    Dim intYear As Integer      '対象年
    
    'クラスのインスタンス
    Set clsKyuyo = New clsSalary
    '配列再定義
    ReDim A(24) As Variant
    '対象年の取得
    'intYear = Year(mobjWS(1).Cells(3, 1).Value)
    'H22.3.31
    intYear = CInt(Me.ComboBox1.Value)
    
    clsKyuyo.GetProperty mobjWS(3), lngRow, 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)
    
    clsKyuyo.MoveData mobjWS(0), intYear
    
    '社員IDを社員名へ変更
    strSyain = Me.lstSyain.List(Me.lstSyain.ListIndex, 1)
    mobjWS(0).Cells(2, 2).Value = strSyain
    
    'クラスの開放
    Set clsKyuyo = Nothing
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    
End Sub

'社員リストの取得
Private Sub GetSyainList()

    Dim clsSyainID() As clsList     '社員リストクラス
    Dim A() As Variant              'データ
    Dim lngRow As Long              '社員データ数
    Dim i As Long                   '長整数型カウンタ
    
    '社員リストの有無
    If mobjWS(2).Cells(1, 1).Value = "" Then GoTo BlankProc
    
    '配列要素数の取得
    lngRow = mobjWS(2).Cells(65536, 1).End(xlUp).Row
        
    ReDim clsSyainID(lngRow - 1) As clsList     'クラス再定義
    ReDim A(lngRow - 1, 1) As Variant           '配列再定義
    
    For i = 0 To lngRow - 1
        '社員リストクラスのインスタンス
        Set clsSyainID(i) = New clsList
        '社員リストの取得
        clsSyainID(i).GetData mobjWS(2), i + 1, 1, 1, 4
        '配列に格納
        A(i, 0) = clsSyainID(i).id
        A(i, 1) = clsSyainID(i).Name
    Next
    
    With Me.lstSyain
        .Clear
        .ColumnCount = 2
        .List() = A
    End With
    
    If IsEmpty(A) = True Then Erase A
    
    'クラスの開放
    For i = 0 To lngRow - 1
        Set clsSyainID(i) = Nothing
    Next
    
    Exit Sub
    
BlankProc:

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

'既定値
Private Sub NewData()
    
    '配列の再定義
    ReDim mobjWS(3) As Worksheet
    
    Set mobjWS(0) = ThisWorkbook.Worksheets("Sheet3")
    Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet1")
    Set mobjWS(2) = Workbooks(gstrName).Worksheets("Sheet2")
    Set mobjWS(3) = Workbooks(gstrName).Worksheets("Sheet5")
    
    Me.lblKomoku.TextAlign = 2
    
    With Me.lblMsg1
        .SpecialEffect = 2
        .Caption = "西暦" & Chr(32) & Chr(32) & Format$(mobjWS(1).Cells(3, 1).Value, "yyyy") & Chr(32) & Chr(32) & "年度"
    End With
    
    With Me.lstSyain
        .Clear
        .ColumnWidths = "0;72"
        .IMEMode = 3
    End With
        
    If Me.cmdOK.Enabled = True Then Me.cmdOK.Enabled = False
    
End Sub

Private Sub NenList()
    
    '年---H22.3.31
    Dim y1 As Integer
    Dim y2 As Integer
    Dim i As Long
    Dim j As Integer
    Dim r As Long
    Dim A() As Integer

    'H22.3.31Version UP
    'コンボボックスに蓄積された年分を格納
    r = mobjWS(3).Cells(65536, 4).End(xlUp).Row
    y1 = 0
    y2 = 0
    j = 0
    For i = 1 To r
        y1 = CInt(Year(mobjWS(3).Cells(i, 4).Value))
        If y2 <> y1 Then
            '配列再定義
            ReDim Preserve A(j) As Integer
            y2 = y1
            A(j) = y2
            j = j + 1
        End If
        y1 = 0
    Next

    Me.ComboBox1.List() = A
    Me.ComboBox1.ListIndex = j - 1
    
End Sub