Option Explicit
'プログレスバー

Private mobjWS() As Worksheet       'ワークシート
'mobjWS(0)：ThisWorkbook![Sheet5]：年末調整支援資料
'mobjWS(1)：Sheet2：社員情報
'mobjWS(2)：Sheet7：配偶者特別控情報
'mobjWS(3)：Sheet8：保険料控除等情報
'mobjWS(4)：Sheet9：前職分情報
'mobjWS(5)：Sheet10：年末調整資料
Private mclsSyain As clsPersonal     '社員クラス
Private mclsZensyoku As clsZensyoku  '前職情報クラス
Private mclsHoken As clsHoken        '保険控除クラス
Private mlngHaigusya() As Long       '配偶者特別控除配列
Private mlngFID() As Long            '外部キー

'OKボタン
Private Sub cmdOK_Click()

    Unload Me
    Call mdlPrint.PrintNentyouSiryou
    
End Sub

'フォームが表示されたら
Private Sub UserForm_Activate()

    '配列の再定義
    ReDim mlngFID(3) As Long
    ReDim ma(35) As Variant
    'クラスのインスタンス
    Set mclsSyain = New clsPersonal
    Set mclsZensyoku = New clsZensyoku
    Set mclsHoken = New clsHoken
    Call MoveData
    
End Sub

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

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

    Dim i As Integer
    
    mobjWS(5).Activate
    mobjWS(5).Range(Cells(1, 1), Cells(65536, 12)).Clear
    
    '配列の開放
    If IsEmpty(mlngFID) = True Then Erase mlngFID
    'クラスの開放
    Set mclsSyain = Nothing
    Set mclsZensyoku = Nothing
    Set mclsHoken = Nothing
    'オフジェクトの開放
    For i = 0 To 5
        Set mobjWS(i) = Nothing
    Next
    
End Sub

'年末調整資料の集計
Private Sub MoveData()

    Dim lngRow As Long  'データ総数
    Dim i As Long       '長整数型カウンタ
    Dim j As Integer    '整数型カウンタ
    Dim k As Long       '長整数型カウンタ
    Dim l As Integer    '整数型カウンタ
    
    'データ総数
    lngRow = mobjWS(5).Cells(65536, 1).End(xlUp).Row
    lngRow = lngRow * 3
    
    On Error Resume Next
    k = 1
    For i = 1 To lngRow Step 3
        'プログレスバー
        Call BarPrint(lngRow / 3, k)
        DoEvents
        '外部キー取得
        Call GetFID(k)
        '社員情報の取得
        Call SyainData(i + 5)
        '配偶者情報取得
        Call HaigusyaTokubetu(i + 5)
        '保険料控除情報取得
        Call Hokenryo(i + 5)
        '前職データ取得
        Call Zensyoku(i + 5)
        '年調情報の取得
        Call NenchoData(i + 5)
        '網掛け
        If k Mod 2 = 0 Then
            For l = 0 To 2
                For j = 1 To 13
                    With mobjWS(0).Cells(l + i + 5, j).Interior
                        .ColorIndex = 37
                        .Pattern = xlSolid
                    End With
                Next
            Next
        End If
        k = k + 1
    Next

    Call LineSet
    Me.lblMsg.Caption = "印刷の準備が整いました..."
    
    If Me.cmdOK.Visible = False Then Me.cmdOK.Visible = True
    
End Sub

'罫線
Private Sub LineSet()

    Dim lngRow As Long      'レコード
    
    'ワークシートとレコード取得
    lngRow = mobjWS(0).Cells(65536, 13).End(xlUp).Row
    'データがないとき
    If lngRow = 5 Then Exit Sub
    
    '-----罫線-----
    mobjWS(0).Activate
    mobjWS(0).Range(Cells(6, 1), Cells(lngRow, 13)).Borders(xlInsideVertical).LineStyle = xlContinuous
    
End Sub

'外部キーの取得
Private Sub GetFID(ByVal lngRow As Long)

'引数[lngRow]：レコード

    Dim i As Integer    '整数型カウンタ
        
    For i = 2 To 5
        mlngFID(i - 2) = CLng(mobjWS(5).Cells(lngRow, i).Value)
    Next
    
End Sub

'年末調整情報
Private Sub NenchoData(ByVal Target As Long)

'引数[Target]：書き込みレコード

    Dim A() As Long     'データ
    Dim lngRow As Long  'レコード
    Dim i As Integer    '整数型カウンタ
    
    '配列再定義
    'ReDim A(5) As Long
    '特別減税に対応
    ReDim A(6) As Long
    'レコード
    lngRow = NenchoRow(mlngFID(0))
    'データの取得
    'For i = 0 To 5
    '特別減税に対応
    For i = 0 To 6
        A(i) = CLng(mobjWS(5).Cells(lngRow, i + 7).Value)
    Next
    
    'ワークシートへ書き込み
    For i = 0 To 3
        mobjWS(0).Cells(Target + 1, i + 2).Value = Format$(A(i), "#,##0")
    Next
    
    mobjWS(0).Cells(Target + 2, 1).Value = Format$(A(4), "#,##0")
    mobjWS(0).Cells(Target + 2, 2).Value = Format$(A(5), "#,##0")
    '特別減税に対応
    mobjWS(0).Cells(Target + 1, 13).Value = Format(A(6), "#,##0")
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    
End Sub

'社員情報
Private Sub SyainData(ByVal Target As Long)

'引数[Target]：書き込みレコード

    Dim lngRow As Long  'レコード
    Dim A() As Variant  'データ
    
    If mlngFID(0) < 1 Then Exit Sub
    '配列再定義
    ReDim A(28) As Variant
    'レコード
    lngRow = SyainRow(mlngFID(0))
    'データの取得
    mclsSyain.GetProperty mobjWS(1), 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), A(25), A(26), A(27), A(28)

    'ワークシートへ書き出し
    mobjWS(0).Cells(Target, 1).Value = A(1)                     '名前
    If A(3) = 0 Then mobjWS(0).Cells(Target, 5).Value = 1       '雇用区分
    If A(5) = 1 Then mobjWS(0).Cells(Target, 4).Value = 1       '死亡退職
    mobjWS(0).Cells(Target + 1, 1).Value = A(6)                 '生年月日
    If A(4) = 1 Then mobjWS(0).Cells(Target, 2).Value = A(7)    '就職日
    If A(5) > 0 Then mobjWS(0).Cells(Target, 3).Value = A(8)    '退職日
    If A(2) = 1 Then mobjWS(0).Cells(Target, 10).Value = A(13)  '一般の寡婦
    If A(2) = 1 Then mobjWS(0).Cells(Target, 11).Value = A(14)  '特別の寡婦
    If A(2) = 0 Then mobjWS(0).Cells(Target, 12).Value = A(13)  '寡夫
    mobjWS(0).Cells(Target, 9).Value = A(15)                    '老年者
    mobjWS(0).Cells(Target, 13).Value = A(16)                   '勤労学生
    mobjWS(0).Cells(Target + 2, 9).Value = A(17)                '控除対象配偶者
    mobjWS(0).Cells(Target + 2, 10).Value = A(18)               '老人控除対象配偶者
    mobjWS(0).Cells(Target + 1, 9).Value = A(20)                '特定扶養親族数
    mobjWS(0).Cells(Target + 1, 11).Value = A(21)               '同居老人扶養親族
    mobjWS(0).Cells(Target + 1, 10).Value = A(22)               '老人扶養親族
    mobjWS(0).Cells(Target + 2, 13).Value = A(23)               '一般の障害者
    mobjWS(0).Cells(Target + 2, 11).Value = A(24)               '特別障害者
    mobjWS(0).Cells(Target + 2, 12).Value = A(25)               '同居特別障害者
    mobjWS(0).Cells(Target, 8).Value = A(26)                    '本人が障害者
    mobjWS(0).Cells(Target, 7).Value = A(27)                    '本人が特別障害者
    mobjWS(0).Cells(Target, 6).Value = A(28)                    '乙欄
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    
End Sub

'配偶者特別控除
Private Sub HaigusyaTokubetu(ByVal Target As Long)

'引数[Target]：書き込みレコード

    Dim lngRow As Long  'レコード
    
    If mlngFID(1) < 1 Then Exit Sub
    '配列再定義
    ReDim mlngHaigusya(1) As Long
    'レコード
    lngRow = TokubetuRow(mlngFID(1))
    'データの取得
    mlngHaigusya(0) = CLng(mobjWS(2).Cells(lngRow, 11).Value)
    mlngHaigusya(1) = CLng(mobjWS(2).Cells(lngRow, 12).Value)
    
    'ワークシートへ書き出し
    mobjWS(0).Cells(Target + 2, 8).Value = Format$(mlngHaigusya(0), "#,##0") '配偶者特別控除額
    mobjWS(0).Cells(Target + 2, 7).Value = Format$(mlngHaigusya(1), "#,##0") '配偶者の所得
    
End Sub

'保険料
Private Sub Hokenryo(ByVal Target As Long)

'引数[Target]：書き込みレコード

    Dim lngRow As Long  'レコード
    Dim A() As Variant  'データ
    Dim i As Integer    '整数型カウンタ
    
    If mlngFID(2) < 1 Then Exit Sub
    '配列再定義
    ReDim A(6) As Variant
    'レコード
    lngRow = HokenRow(mlngFID(2))
    'データの取得
    mclsHoken.GetProperty mobjWS(3), lngRow, A(0), A(1), A(2), A(3), A(4), A(5), A(6)
    
    'ワークシートへ書き出し
    For i = 2 To 6
        mobjWS(0).Cells(Target + 2, i).Value = Format$(A(i), "#,##0")
    Next
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    
End Sub

'前職
Private Sub Zensyoku(ByVal Target As Long)

'引数[Target]：書き込みレコード

    Dim lngRow As Long  'レコード
    Dim A() As Variant  'データ
    Dim i As Integer    '整数型カウンタ
    
    If mlngFID(3) < 1 Then Exit Sub
    '配列の再定義
    ReDim A(4) As Variant
    'レコード
    lngRow = ZensyokuRow(mlngFID(3))
    'データの取得
    mclsZensyoku.GetProperty mobjWS(4), lngRow, A(0), A(1), A(2), A(3), A(4)
    
    'ワークシートへ書き出し
    For i = 6 To 8
        mobjWS(0).Cells(Target + 1, i).Value = Format$(A(i - 4), "#,##0")
    Next
    
    mobjWS(0).Cells(Target + 1, 2).Value = Format$(mobjWS(0).Cells(Target + 1, 2).Value + A(2), "#,##0") '前職分給与
    mobjWS(0).Cells(Target + 2, 2).Value = Format$(mobjWS(0).Cells(Target + 2, 2).Value + A(3), "#,##0") '前職分社会保険
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    
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()

    '配列再定義
    ReDim mobjWS(5) As Worksheet
    'ワークシート
    Set mobjWS(0) = ThisWorkbook.Worksheets("Sheet5")
    Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet2")
    Set mobjWS(2) = Workbooks(gstrName).Worksheets("Sheet7")
    Set mobjWS(3) = Workbooks(gstrName).Worksheets("Sheet8")
    Set mobjWS(4) = Workbooks(gstrName).Worksheets("Sheet9")
    Set mobjWS(5) = Workbooks(gstrName).Worksheets("Sheet10")
    
    With Me.lblBar2
        .Width = 0
        .BackColor = RGB(0, 0, 255)
    End With
    
    Me.cmdOK.Visible = False
    
End Sub

'年調情報の社員IDと一致するレコードの取得
Private Function NenchoRow(ByVal lngID As Long)

'引数[lngID]：社員ID

    Dim lngRow As Long      'レコード
    
    'レコード数の取得
    lngRow = mobjWS(5).Cells(65536, 2).End(xlUp).Row
    '該当するレコードの取得
    mobjWS(5).Activate
    NenchoRow = mobjWS(5).Range(Cells(1, 2), Cells(lngRow, 2)).Find(lngID, Cells(lngRow, 2), xlValues).Row
    
End Function

'社員IDと一致するレコードの取得
Private Function SyainRow(ByVal lngID As Long)

'引数[lngID]：社員ID

    Dim lngRow As Long      'レコード
        
    'レコード数の取得
    lngRow = mobjWS(1).Cells(65536, 1).End(xlUp).Row
    '該当するレコードの取得
    mobjWS(1).Activate
    SyainRow = mobjWS(1).Range(Cells(1, 1), Cells(lngRow, 1)).Find(lngID, Cells(lngRow, 1), xlValues).Row
    
End Function

'配偶者特別控除IDと一致するレコードの取得
Private Function TokubetuRow(ByVal lngID As Long)

'引数[lngID]：配偶者特別控除ID

    Dim lngRow As Long      'レコード
        
    'レコード数の取得
    lngRow = mobjWS(2).Cells(65536, 1).End(xlUp).Row
    '該当するレコードの取得
    mobjWS(2).Activate
    TokubetuRow = mobjWS(2).Range(Cells(1, 1), Cells(lngRow, 1)).Find(lngID, Cells(lngRow, 1), xlValues).Row

End Function

'保険料控除IDと一致するレコードの取得
Private Function HokenRow(ByVal lngID As Long)

'引数[lngID]：保険料控除ID

    Dim lngRow As Long      'レコード
        
    'レコード数の取得
    lngRow = mobjWS(3).Cells(65536, 1).End(xlUp).Row
    '該当するレコードの取得
    mobjWS(3).Activate
    HokenRow = mobjWS(3).Range(Cells(1, 1), Cells(lngRow, 1)).Find(lngID, Cells(lngRow, 1), xlValues).Row

End Function

'前職分IDと一致するレコードの取得
Private Function ZensyokuRow(ByVal lngID As Long)

'引数[lngID]：前職分ID

    Dim lngRow As Long      'レコード
        
    'レコード数の取得
    lngRow = mobjWS(4).Cells(65536, 1).End(xlUp).Row
    '該当するレコードの取得
    mobjWS(4).Activate
    ZensyokuRow = mobjWS(4).Range(Cells(1, 1), Cells(lngRow, 1)).Find(lngID, Cells(lngRow, 1), xlValues).Row

End Function