社員名簿を作る　～その1～

Sub sosikikosin(d As Date)
    Dim today_d As Date, str_d As Date, end_d As Date
    Dim honbu As String, bu As String, ka As String, kakari As String    
    Worksheets("現在の組織").Activate
    n = Worksheets("現在の組織").Cells(Rows.Count, 1).End(xlUp).Row
    If n > 2 Then
        Worksheets("現在の組織").Range(Cells(3, 1), Cells(n, 6)).ClearContents
        Worksheets("現在の組織").Range(Cells(3, 1), Cells(n, 6)).Borders.LineStyle = xlLineStyleNone
    End If
    For r = 2 To Worksheets("組織DB").Cells(Rows.Count, 1).End(xlUp).Row                
        With Worksheets("組織DB")
            today_d = d
            str_d = .Cells(r, 1)
            end_d = .Cells(r, 2)
            honbu = .Cells(r, 3)
            bu = .Cells(r, 4)
            ka = .Cells(r, 5)
            kakari = .Cells(r, 6)
        End With    
        If (str_d <= today_d And today_d <= end_d) Or (str_d <= today_d And end_d = 0) Then
            With Worksheets("組織マスター")
                Set rcd_honbu = .Range("a:a").Find(honbu, lookat:=xlWhole)
                Set rcd_bu = .Range("c:c").Find(bu, lookat:=xlWhole)
                Set rcd_ka = .Range("e:e").Find(ka, lookat:=xlWhole)
                Set rcd_kakari = .Range("g:g").Find(kakari, lookat:=xlWhole)
                code = rcd_honbu.Offset(0, 1) * 1000000 + rcd_bu.Offset(0, 1) * 10000 + rcd_ka.Offset(0, 1) * 100 + rcd_kakari.Offset(0, 1)
            End With        
            With Worksheets("現在の組織")
                n = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Cells(n, 1) = r
                .Cells(n, 2) = honbu
                .Cells(n, 3) = bu
                .Cells(n, 4) = ka
                .Cells(n, 5) = kakari
                .Cells(n, 6) = code
            End With    
        End If
    Next r        
    n = Worksheets("現在の組織").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("現在の組織").Range("A2:f" & n).Sort _
    Key1:=Range("f2"), Order1:=xlAscending, _
    Header:=xlYes    
    Worksheets("現在の組織").Range("A2:f" & n).Borders.LineStyle = xlContinuous
    Worksheets("現在の組織").Range("a1") = d & "現在組織リスト"    
End Sub

Private Sub Workbook_Open()
    Call Module1.syokika
End Sub

Sub syokika()
    Application.ScreenUpdating = False
    
        Dim d As Date
        d = Date
        Call Module1.sosikikosin(d)
    Application.ScreenUpdating = True
End Sub

Sub ninikosin()
    Application.ScreenUpdating = False
        Dim d As Date
        d = InputBox("基準日を入力")
        Call Module1.sosikikosin(d)
        Dim TargetBook As Workbook
        Worksheets("現在の組織").Copy
        Set TargetBook = ActiveWorkbook
        ThisWorkbook.Activate
        d = Date
        Call Module1.sosikikosin(d)
        Worksheets("menu").Activate
        TargetBook.Activate
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim cmdBar1 As CommandBarControl
    For Each cmdBar1 In Application.CommandBars("cell").Controls
        If cmdBar1.Caption = "組織の廃止" Or cmdBar1.Caption = "組織の新設" Then
            cmdBar1.Delete
        End If
    Next
    With Application.CommandBars("cell").Controls.Add
        .Caption = "組織の廃止"
        .OnAction = "org_abolish"
    End With
    With Application.CommandBars("cell").Controls.Add
        .Caption = "組織の新設"
        .OnAction = "org_built"
    End With
End Sub

Private Sub Worksheet_Deactivate()
    Dim cmdBar1 As CommandBarControl
    For Each cmdBar1 In Application.CommandBars("cell").Controls
        If cmdBar1.Caption = "組織の廃止" Or cmdBar1.Caption = "組織の新設" Then
            cmdBar1.Delete
        End If
    Next
End Sub

Sub org_abolish()
    Dim n As Range, end_d As Date, o As Long
    end_d = InputBox("廃止日を入力")
    For Each n In Selection
        o = Worksheets("現在の組織").Cells(n.Row, 1)
        If o <> 0 Then
            Worksheets("組織DB").Cells(o, 2) = end_d
        End If
    Next n
    Dim d As Date
    d = Date
    Call Module1.sosikikosin(d)
End Sub

Sub org_built()
    Dim n As Range, end_d As Date, honbu As String, bu As String, ka As String, kakari As String, m As Long, pre_row As Integer
    str_d = InputBox("設置日を入力")
    For Each n In Selection
        If n.Row = pre_row Then GoTo 5
        honbu = Worksheets("現在の組織").Cells(n.Row, 2)
            Set rcd = Worksheets("組織マスター").Range("a:a").Find(honbu, lookat:=xlWhole)
            If rcd Is Nothing Then
                MsgBox honbu & "は、組織マスターに登録されていません。組織マスターの「本部」と「本部コード」を追加してください"
                GoTo 10
            End If
        bu = Worksheets("現在の組織").Cells(n.Row, 3)
            Set rcd = Worksheets("組織マスター").Range("c:c").Find(bu, lookat:=xlWhole)
            If rcd Is Nothing Then
                MsgBox bu & "は、組織マスターに登録されていません。組織マスターの「部」と「部コード」を追加してください"
                GoTo 10
            End If
        ka = Worksheets("現在の組織").Cells(n.Row, 4)
            Set rcd = Worksheets("組織マスター").Range("e:e").Find(ka, lookat:=xlWhole)
            If rcd Is Nothing Then
                MsgBox ka & "は、組織マスターに登録されていません。組織マスターの「課」と「課コード」を追加してください"
                GoTo 10
            End If
        kakari = Worksheets("現在の組織").Cells(n.Row, 5)
            Set rcd = Worksheets("組織マスター").Range("f:f").Find(kakari, lookat:=xlWhole)
            If rcd Is Nothing Then
                MsgBox kakari & "は、組織マスターに登録されていません。組織マスターの「係」と「係コード」を追加してください"
                GoTo 10
            End If
        m = Worksheets("組織DB").Cells(Rows.Count, 1).End(xlUp).Row + 1
        Worksheets("組織DB").Cells(m, 1) = str_d
        Worksheets("組織DB").Cells(m, 3) = honbu
        Worksheets("組織DB").Cells(m, 4) = bu
        Worksheets("組織DB").Cells(m, 5) = ka
        Worksheets("組織DB").Cells(m, 6) = kakari
        pre_row = n.Row
5
    Next n    
    Selection.EntireRow.Delete 
    Dim d As Date
    d = Date
    Call Module1.sosikikosin(d)
10
End Sub