Option Explicit
'扶養家族フォーム

Private mobjWS() As Worksheet   'ワークシート
'mobjWS(0):Sheet3：家族情報
'mobjWS(1)：Sheet1：社員情報

Private mlngRow As Long         'レコード番号

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

    Call NewData
    Call GetSyainList
    
End Sub

'削除ボタン
Private Sub cmdDelete_Click()

    Dim intMsg As Integer   'メッセージ
    
    intMsg = MsgBox("削除しますか。", 32 + 4, "給与計算システム")
    
    '削除
    If intMsg = 6 Then
        mobjWS(0).Cells(mlngRow, 1).EntireRow.Delete
        Call NewData
    End If
    
End Sub

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

    Unload Me
    
End Sub

'登録ボタン
Private Sub cmdOK_Click()

    Dim intMsg As Integer   'メッセージの戻り値
        
    If Me.lstSyain.ListIndex = -1 Then GoTo ListErrorProc
    If IsDate(Me.txtDate.Text) = False Then GoTo DateErrorProc
    
    intMsg = MsgBox("登録しますか。", 32 + 4, "給与計算システム")
    
    '登録
    If intMsg = 6 Then
        Call LetData
        MsgBox "正常に登録しました。", 64 + 0, "給与計算システム"
    End If
    
    'ユーザーフォームを初期値へ
    Call NewData
    Call GetSyainList
    
    Exit Sub
    
ListErrorProc:

    MsgBox "社員が選択されていません。" & vbCrLf & "選択し直して下さい。", 48 + 0, "給与計算システム"
    Exit Sub
    
DateErrorProc:

    MsgBox "生年月日の値が不正です。", 16 + 0, "給与計算システム"
    
End Sub

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

    Dim intMsg As Integer   'メッセージ
    Dim lngID As Long       '主キー
    
    'レコード数の再定義
    If mobjWS(0).Cells(1, 1).Value = "" Then
        mlngRow = 0
    Else
        mlngRow = mobjWS(0).Cells(65536, 1).End(xlUp).Row
    End If
    
    '入力コントロールをクリア
    Call ClearData
    
    '家族情報取得
    On Error GoTo ErrorProc
    If Me.lstKazoku.ListIndex = -1 Then Exit Sub
    intMsg = MsgBox("訂正しますか。", 32 + 4, "給与計算システム")
    On Error GoTo 0
    
    If intMsg = 6 Then
        Me.cmdDelete.Enabled = True
        '主キーの取得
        lngID = CLng(Me.lstKazoku.List(Me.lstKazoku.ListIndex, 0))
        Call GetData(lngID)
    ElseIf intMsg = 7 Then
        Me.lstSyain.ListIndex = -1
        Me.lstKazoku.ListIndex = -1
        'フォームのリフレッシュ
        Call NewData
        '社員リストの取得
        Call GetSyainList
    End If
    
    Exit Sub
    
ErrorProc:

    MsgBox "家族リストは空です。", 48 + 0, "給与計算システム"
    
End Sub

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

    Dim lngID As Long   '社員ＩＤ
    
    '社員ＩＤ（外部キー）の取得
    lngID = Me.lstSyain.List(Me.lstSyain.ListIndex, 0)
    
    '該当する家族情報
    Call GetKazokuList(lngID)
    
    '入力コントロールをクリア
    Call ClearData
    
End Sub

'フォーカスが当ったとき（生年月日）
Private Sub txtDate_Enter()

    With Me.txtDate
        .BackColor = RGB(255, 255, 0)
        If .Text = "" Then .Text = Format$(Now, "yyyy/mm/dd")
        .SelStart = 0
        .SelLength = Len(.Text)
        .TextAlign = 1
        .IMEMode = 3
    End With
    
End Sub

'フォーカスが外れたとき（生年月日）
Private Sub txtDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtDate
        .BackColor = RGB(255, 255, 255)
        .Text = Format$(.Text, "yyyy/mm/dd")
        .IMEMode = 0
    End With
    
End Sub

'フォーカスがあたったとき（名前）
Private Sub txtName_Enter()

    With Me.txtName
        .BackColor = RGB(255, 255, 0)
        .SelStart = 0
        .SelLength = Len(.Text)
        .SetFocus
        .IMEMode = 4
    End With
    
End Sub

'フォーカスが外れたとき（名前）
Private Sub txtName_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtName
        .BackColor = RGB(255, 255, 255)
        .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 1
        Set mobjWS(i) = Nothing
    Next
    
End Sub

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

'引数[lngID]：家族ＩＤ

    Dim clsFuyou As clsKazoku   '家族クラス
    Dim A() As Variant          'データ
    Dim lngRow As Long          'レコード
    Dim i As Long               '長整数型カウンタ
    
    ReDim A(4) As Variant       '配列再定義
        
    '家族ＩＤと一致するレコードの取得
    mobjWS(0).Activate
    lngRow = mobjWS(0).Range(Cells(1, 1), Cells(mlngRow, 1)).Find(lngID, Cells(mlngRow, 1), xlValues).Row
    'カレントレコード移動
    mlngRow = lngRow - 1
    '家族クラスのインスタンス
    Set clsFuyou = New clsKazoku
    'ワークシートの値を取得
    clsFuyou.GetProperty mobjWS(0), mlngRow + 1, A(0), A(1), A(2), A(3), A(4)
    
    With Me
        .txtName.Text = A(2)
        If A(3) = 0 Then .optSex1.Value = True
        If A(3) = 1 Then .optSex2.Value = True
        If A(3) = 2 Then .optSex1.Value = False: .optSex2.Value = False
        .txtDate.Text = Format$(A(4), "yyyy/mm/dd")
    End With
    
    Set clsFuyou = Nothing
    
End Sub

'フォーム値を配列で受け取る
Private Sub LetData()

    Dim clsFuyou As clsKazoku       '家族クラス
    Dim A() As Variant              'データ
    Const lngNextNum As Long = 1    '主キー自動附番
    
    ReDim Preserve A(4) As Variant    '配列再定義
        
    'データの取得
    If mlngRow > 0 Then
        A(0) = CLng(mobjWS(0).Cells(mlngRow, 1).Value) + lngNextNum
    ElseIf mlngRow = 0 Then
        A(0) = CLng(1)
    Else
        GoTo ErrorProc
    End If
    
    A(1) = CLng(Me.lstSyain.List(Me.lstSyain.ListIndex, 0))
    A(2) = CStr(Me.txtName.Text)
    If Me.optSex1.Value = True Then A(3) = CInt(0)
    If Me.optSex2.Value = True Then A(3) = CInt(1)
    If Me.optSex1.Value = False And Me.optSex2.Value = False Then GoTo SexErrorProc
    If IsDate(Me.txtDate.Text) = True Then
        A(4) = CDate(Me.txtDate.Text)
    Else
        GoTo DateErrorProc
    End If
    
    '家族クラスのインスタンス
    Set clsFuyou = New clsKazoku
    
    clsFuyou.LetProperty mobjWS(0), mlngRow + 1, A(0), A(1), A(2), A(3), A(4)
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    
    'クラスの開放
    Set clsFuyou = Nothing
    
    Exit Sub
    
SexErrorProc:

    MsgBox "性別は、かならず選択して下さい。", 48 + 0, "給与計算システム"
    Exit Sub
    
DateErrorProc:

    MsgBox "日付に変換できません。" & vbCrLf & "入力例：2000/4/1", 48 + 0, "給与計算システム"
    Exit Sub
    
ErrorProc:

    MsgBox "主キーデータ値が不正です。" & vbCrLf & "サポートを受けて下さい。", 16 + 0, "給与計算システム"
    
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(0).Cells(1, 1).Value = "" Then GoTo BlankProc
        
    '外部キーに該当する家族リスト数の取得
    mobjWS(0).Activate
    'レコード数の取得
    lngRow = mobjWS(0).Cells(65536, 1).End(xlUp).Row
    If lngRow < mlngRow Then lngRow = mlngRow
    
    Set rngArea = mobjWS(0).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 mlngRow
        If mobjWS(0).Cells(i, 2).Value = lngID Then
            '家族リストクラスのインスタンス
            Set clsKazokuID(j) = New clsList
            '家族リストの取得
            clsKazokuID(j).GetData mobjWS(0), 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 objLB As MSForms.Label      'ラベル
    Dim i As Integer        'フラグ&カウンタ
    Dim j As Integer        '整数型カウンタ
    
    ReDim mobjWS(1) As Worksheet   '配列の再定義
    
    'ワークシートオブジェクトのインスタンス
    Set mobjWS(0) = Workbooks(gstrName).Worksheets("Sheet3")
    Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet2")
    
    'レコード
    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 2
        Set objLB = Controls("lblKazoku" & CStr(i))
        objLB.TextAlign = 3
    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
    
    Call ClearData
    Set objLB = Nothing
    
End Sub

'入力コントロール内のデータをクリア
Private Sub ClearData()

    With Me
        .cmdDelete.Enabled = False
        .optSex1.Value = True
        .optSex2.Value = False
        .txtDate.Text = ""
        With .txtName
            .Text = ""
            .SetFocus
        End With
    End With
    
End Sub