Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "Sheet3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit


Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit


Attribute VB_Name = "Sheet4"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit


Attribute VB_Name = "Sheet7"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit


Attribute VB_Name = "Sheet5"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit


Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Saved = True
End Sub


Attribute VB_Name = "frm表示"
Attribute VB_Base = "0{759B255F-308C-4741-A6E7-4AE540F926E8}{E481945B-03EA-4F0F-94D0-51937FFFF25B}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Option Explicit

Private Sub CommandButton1_Click()
'20131003 kon
'    If OptionButton1.Value = True Then
'        CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\年末調整のおしらせ.doc"
'    ElseIf OptionButton2.Value = True Then
'        CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\扶養控除申告書25裏面.pdf"
'    ElseIf OptionButton3.Value = True Then
'        CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\保険料控除申告書24裏面.pdf"
'    ElseIf OptionButton4.Value = True Then
'        CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\扶養控除申告書25記載例.pdf"
'    ElseIf OptionButton5.Value = True Then
'        CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\保険料控除記載方法24年.pdf"
'    ElseIf OptionButton6.Value = True Then
'        CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\扶養控除申告書24裏面.pdf"
'    ElseIf OptionButton7.Value = True Then
'        CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\扶養控除申告書24記載例.pdf"
'
'    End If



    Dim iCnt As Integer
    
    For iCnt = 1 To 7
        If Controls("OptionButton" & iCnt).Value Then Exit For
    Next iCnt

    If iCnt = 1 Then
        CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\年末調整のおしらせ.doc"
    Else
        CreateObject("Shell.Application").ShellExecute ThisWorkbook.Path & "\" & Controls("OptionButton" & iCnt).Caption & ".pdf"
    End If
    
    Unload Me
End Sub

Private Sub UserForm_Activate()
'20131003 kon
    OptionButton2.Caption = "扶養控除申告書" & 年度 - 1988 & "裏面"
    OptionButton3.Caption = "保険料控除申告書" & 年度 - 1989 & "裏面"
    OptionButton4.Caption = "扶養控除申告書" & 年度 - 1988 & "記載例"
    OptionButton5.Caption = "保険料控除記載方法" & 年度 - 1989 & "年"
    OptionButton6.Caption = "扶養控除申告書" & 年度 - 1989 & "裏面"
    OptionButton7.Caption = "扶養控除申告書" & 年度 - 1989 & "記載例"
End Sub



Attribute VB_Name = "作成F"
Attribute VB_Base = "0{420E8AA2-5255-4D26-B0EA-D5FF57E92F6A}{34180E37-8F5E-4C2D-8F0A-4645BB192037}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Option Explicit
Dim 列 As Integer
Dim 開始行 As Long
Dim Ac As String
Dim Nendo As Long

Private Sub CheckBox9_Click()
Dim i As Long
For i = 0 To ListBox2.ListCount - 1
ListBox2.Selected(i) = CheckBox9.Value
Next
End Sub

Private Sub CommandButton1_Click()
    Dim i As Long
    Dim n As Long
    If Trim(TextBox1.Value) = "" Then
        MsgBox "検索文字(No、氏名)を指定してから実行してください。", 16, "検索"
        Exit Sub
    End If
    ListBox2.Clear
    With ListBox1
        n = 0
        For i = 0 To .ListCount - 1
            If .List(i, 0) & .List(i, 1) Like "*" & TextBox1.Value & "*" Then '氏名またはNoが一致したら
                ''' 20101102 笹
                'ListBox2.AddItem i + 2
                ListBox2.AddItem i + 6
                ''' END 20101102 笹
                ListBox2.List(n, 1) = .List(i, 0)
'                ListBox2.List(n, 2) = .List(i, 1)
                n = n + 1
            End If
        Next
    End With
    If ListBox2.ListCount = 0 Then
        MsgBox "データは見つかりません。", 16, "検索"
        OptionButton1_Click
    End If
End Sub
Private Sub CommandButton10_Click()
    Dim i As Long
    Dim n As Long
    n = 0
    Dim oShape As Shape     'YB29337 fuku 20151104
    
    
    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            n = 1
            Exit For
        End If
    Next
    If n = 0 Then
        MsgBox "データが選択されていません。", 16, "エラー"
        Exit Sub
    End If
    nensyo = ""
    fuyoshinzoku = ""
    
    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
                If ActiveSheet.Name = "扶養控除前年" Then
                Call 作成2(Val(ListBox2.List(i, 0)), Nendo)
                Else
                Call 作成(Val(ListBox2.List(i, 0)), Nendo)
                End If
            Exit For
        End If
    Next
    If fuyoshinzoku <> "" Then
        MsgBox "以下の人の扶養親族が５人を超えています。確認してください。　" & vbCr & fuyoshinzoku, vbInformation, "表示"
    End If
    
    If nensyo <> "" Then
        MsgBox "以下の人の年少扶養家族が３人を超えています。確認してください。　" & vbCr & nensyo, vbInformation, "表示"
    End If


'YB29337 fuku 20151104------------------------------------------------------------------------------
    ActiveSheet.Unprotect
    
    If CheckBox10 = True Then
        Range("U9:Z11,F18:J18,G20:J20,G22:J22,G24:J24,G26:J26,G28:J28,I42:P43,I44:P45,I46:P47").Borders(xlDiagonalUp).LineStyle = xlContinuous    '個人番号に斜線
        For Each oShape In ActiveSheet.Shapes
            oShape.Visible = True
        Next
        ActiveSheet.Shapes.Range(Array("図 49", "図 48", "図 47", "図 50", "図 51", "図 52", "図 39", "図 44", "図 45", "図 46")).Select
        Selection.ShapeRange.Visible = False                                                            '個人番号のオブジェクトを非表示に
    Else
        Range("U9:Z11,F18:J18,G20:J20,G22:J22,G24:J24,G26:J26,G28:J28,I42:P43,I44:P45,I46:P47").Select
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone                         '斜線を消す
        For Each oShape In ActiveSheet.Shapes
            oShape.Visible = True                              'オブジェクトを表示させる
        Next

    End If
    
    Range("B2").Select
    
    
    ActiveSheet.Protect


'-------------------------------------------------------------------------------------YB29337 fuku 20151104


    Unload Me

End Sub

Private Sub CommandButton11_Click()
    Dim i As Long
    Dim n As Long
    Dim FSO As Object
    Dim Fn As String
    Dim Nam As String
    Dim P As String

    
 'YB29337 fuku 20151104------------------------
    If CheckBox10 = True Then    '個人番号表示のフラグ
        Cells(1, 45).Value = 1

    ElseIf CheckBox10 = False Then
        Cells(1, 45).Value = ""

    End If
 '--------------------------YB29337 fuku 20151104

    Set FSO = CreateObject("Scripting.FileSystemObject")
    '単体とろうむノート
    If FSO.FolderExists(ThisWorkbook.Path & "\扶養控除申告書") = False Then '扶養控除フォルダがねれば作成する
       FSO.CreateFolder ThisWorkbook.Path & "\扶養控除申告書"
    End If
    If FSO.FolderExists(ThisWorkbook.Path & "\扶養控除申告書\" & Nendo) = False Then '年フォルダがなかったら作成する
       FSO.CreateFolder ThisWorkbook.Path & "\扶養控除申告書\" & Nendo
    End If
    P = ThisWorkbook.Path & "\扶養控除申告書\" & Nendo
    'Cells給与と台帳
    If Worksheets("DATA").Cells(1, 2).Value = 1 Or Worksheets("DATA").Cells(1, 2).Value = 2 Then  'Cells給与、台帳
        Fn = Left(Worksheets("DATA").Cells(1, 1).Value, Len(Worksheets("DATA").Cells(1, 1).Value) - 6)
        If FSO.FolderExists(ThisWorkbook.Path & "\扶養控除申告書\" & Nendo & "\" & Fn) = False Then '事業名フォルダがなかったら作成する
           FSO.CreateFolder ThisWorkbook.Path & "\扶養控除申告書\" & Nendo & "\" & Fn
        End If
        P = ThisWorkbook.Path & "\扶養控除申告書\" & Nendo & "\" & Fn
    End If
    
    n = 0
    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            n = 1
            Exit For
        End If
    Next
    If n = 0 Then
        MsgBox "データが選択されていません。", 16, "エラー"
        Exit Sub
    End If
    Application.DisplayAlerts = False
    If MsgBox("保存（ファイル出力）しますか？", 4 + 32, "保存") <> 6 Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            Label57.Caption = ListBox2.List(i, 1) & "さんを処理しています。"
            DoEvents
            If ActiveSheet.Name = "扶養控除前年" Then
            Call 作成2(Val(ListBox2.List(i, 0)), Nendo)
            Else
            Call 作成(Val(ListBox2.List(i, 0)), Nendo)
            End If

            Call 出力 '20121015 titti 保存の形式をかえた
            If Val(Application.Version) < 12 Then
                'YBNO 29255  ito 20151026
                'ActiveWorkbook.SaveAs P & "\" & Format(Cells(5, 3).Value, "000000 ") & Cells(8, 21).Value & ".xls"
                If ActiveSheet.Name = "扶養控除前年" Then
                    ActiveWorkbook.SaveAs P & "\" & Format(Cells(9, 3).Value, "000000 ") & Cells(12, 23).Value & ".xls"
                Else
                    ActiveWorkbook.SaveAs P & "\" & Format(Cells(5, 3).Value, "000000 ") & Cells(8, 21).Value & ".xls"
                End If
            Else
                'YBNO 29255  ito 20151026
                'ActiveWorkbook.SaveAs P & "\" & Format(Cells(5, 3).Value, "000000 ") & Cells(8, 21).Value & ".xls", FileFormat:=56
                If ActiveSheet.Name = "扶養控除前年" Then
                    ActiveWorkbook.SaveAs P & "\" & Format(Cells(9, 3).Value, "000000 ") & Cells(12, 23).Value & ".xls", FileFormat:=56
                Else
                    ActiveWorkbook.SaveAs P & "\" & Format(Cells(5, 3).Value, "000000 ") & Cells(8, 21).Value & ".xls", FileFormat:=56
                End If
            End If

            
            
            Nam = ActiveWorkbook.Name
            ThisWorkbook.Activate
            '20121017 kon
            Workbooks(Nam).Close False

        End If
    Next
    Label57.Caption = ""
'    Workbooks(Nam).Close False
    ThisWorkbook.Activate
    Range("A1").Select
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "保存しました。", 64, "保存"
    Unload Me
End Sub
Private Sub 出力()
    Dim s As Shape
    Dim sh As String
    Dim w As Worksheet
    Dim oShape As Shape   'YB29337 fuku 20151104
    
    sh = ActiveSheet.Name
    Sheets(Array(sh, "保険料控除")).Copy
    For Each w In Worksheets
        w.Activate
        w.Unprotect
        Cells.Copy
        Cells.PasteSpecial Paste:=xlPasteValues
        For Each s In ActiveSheet.Shapes
            If s.OnAction <> "" Or s.Top < 40 Then
                s.Delete
            End If
        Next
        
         'YB29337 fuku 20151104-----------------------------
            If Cells(1, 45).Value = 1 Then
                If CheckBox10 = True Then
                    Range("U9:Z11,F18:J18,G20:J20,G22:J22,G24:J24,G26:J26,G28:J28,I42:P43,I44:P45,I46:P47").Borders(xlDiagonalUp).LineStyle = xlContinuous
                        For Each oShape In ActiveSheet.Shapes
                            oShape.Visible = True
                        Next
                    ActiveSheet.Shapes.Range(Array("図 49", "図 48", "図 47", "図 50", "図 51", "図 52", "図 39", "図 44", "図 45", "図 46")).Select
                    Selection.ShapeRange.Visible = False
                Else
                    Range("U9:Z11,F18:J18,G20:J20,G22:J22,G24:J24,G26:J26,G28:J28,I42:P43,I44:P45,I46:P47").Select
                    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                    For Each oShape In ActiveSheet.Shapes
                        oShape.Visible = True
                    Next
    
                End If
                
            Else
                    Range("U9:Z11,F18:J18,G20:J20,G22:J22,G24:J24,G26:J26,G28:J28,I42:P43,I44:P45,I46:P47").Select
                    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                    For Each oShape In ActiveSheet.Shapes
                        oShape.Visible = True
                    Next
                                
            End If
            
             '----------------------------------------YB29337 fuku 20151104
        
        
        ActiveWindow.FreezePanes = False
        ActiveWindow.SplitRow = 0

        Cells(1, 1).Select
    Next
    Sheets(sh).Select
    Application.CutCopyMode = False
    Cells(1, 1).Select
End Sub

Private Sub CommandButton12_Click()
    Workbooks("社員情報.xls").Activate
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.Visible = True
    Unload Me

End Sub

Private Sub CommandButton4_Click()
    Dim i As Long
    Dim n As Long
    Dim MyF As String
    Dim oShape As Shape
    n = 0
    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            n = 1
            Exit For
        End If
    Next
    If n = 0 Then
        MsgBox "データが選択されていません。", 16, "エラー"
        Exit Sub
    End If
    If CheckBox3.Value = False And CheckBox4.Value = False Then
        MsgBox "印刷する申告書を選択してください。", 16, "エラー"
        Exit Sub
    End If
    If MsgBox("プリンタの準備はいいですか？", 4 + 32, "印刷") <> 6 Then Exit Sub
    Application.ScreenUpdating = False
    nensyo = ""
    fuyoshinzoku = ""  'fuyo fuku
    For n = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(n) = True Then
                If ActiveSheet.Name = "扶養控除前年" Then
                Call 作成2(Val(ListBox2.List(n, 0)), Nendo)
                Else
                Call 作成(Val(ListBox2.List(n, 0)), Nendo)
                End If
                DoEvents
                If CheckBox3.Value = True Then
                
                     'YB29337 fuku 20151104----------------------------------------
                ActiveSheet.Unprotect
                
                    If CheckBox10 = True Then
                        Range("U9:Z11,F18:J18,G20:J20,G22:J22,G24:J24,G26:J26,G28:J28,I42:P43,I44:P45,I46:P47").Borders(xlDiagonalUp).LineStyle = xlContinuous
                        For Each oShape In ActiveSheet.Shapes
                            oShape.Visible = True
                        Next
                        ActiveSheet.Shapes.Range(Array("図 49", "図 48", "図 47", "図 50", "図 51", "図 52", "図 39", "図 44", "図 45", "図 46")).Select
                        Selection.ShapeRange.Visible = False
                    Else
                        Range("U9:Z11,F18:J18,G20:J20,G22:J22,G24:J24,G26:J26,G28:J28,I42:P43,I44:P45,I46:P47").Select
                        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                        For Each oShape In ActiveSheet.Shapes
                            oShape.Visible = True
                        Next
        
                    End If
                    
                 ActiveSheet.Protect
            
                
                    '--------------------------------------------YB29337 fuku 20151104
                    
                    Worksheets(Ac).PrintOut
                End If
                
'20121024 kon
'                If CheckBox4.Value = True  Then
                If CheckBox4.Value = True And CheckBox4.Enabled = True Then
                    
                    Worksheets("保険料控除").PrintOut
                End If
                DoEvents
        End If
    
    Next
    If fuyoshinzoku <> "" Then
        MsgBox "以下の人の扶養親族が５人を超えています。確認してください。　" & vbCr & fuyoshinzoku, vbInformation, "印刷"
    End If
    
    If nensyo <> "" Then
        MsgBox "以下の人の年少扶養家族が３人を超えています。確認してください。　" & vbCr & nensyo, vbInformation, "印刷"
    End If
    Application.ScreenUpdating = True
    Range("B2").Select
    Unload Me

End Sub

Private Sub CommandButton7_Click()
    Application.ScreenUpdating = False

    Sheets("保険料控除").Select
    Range("C6:AR8").Value = Range("BF6:CU8").Value2
    Cells(1, 1).Select
    Sheets("扶養控除").Select
    'YBNO 29234  ito 20151026
    'Range("B11:AG52").Value = Range("AO11:BT52").Value2
    Range("B7:AI52").Value = Range("AO7:BV52").Value2
    Cells(1, 1).Select
    Unload Me
    MsgBox "印字調整後は「印刷設定保存」をクリックしてください。", 64, "印字調整"
    Application.ScreenUpdating = True
End Sub

Private Sub CommandButton8_Click()
    Dim MyF As String
    Dim i As Long
    Dim n As Long
    n = 0
    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            n = 1
            Exit For
        End If
    Next
    If n = 0 Then
        MsgBox "リストを選択してください。", 16, "エラー"
        Exit Sub
    End If
    If MsgBox("プリンタの準備はいいですか？", 4 + 32, "印刷") <> 6 Then Exit Sub
    Application.ScreenUpdating = False
    If Left(Cells(15, 8).Value, 1) = "○" Then 'サンプルデータが表示されていたら
        Call データのみ初期処理 '会社データを移す
    End If

    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            Call 作成(Val(ListBox2.List(i, 0)), Nendo)
            If OptionButton4 = True Then
                DoEvents
                Worksheets("扶養控除").PrintOut
                DoEvents
            End If
            If OptionButton5.Value = True Then
                DoEvents
                Worksheets("保険料控除").PrintOut
                DoEvents
            End If

        End If
    Next
    Application.ScreenUpdating = True
    Unload Me

End Sub


Private Sub CommandButton9_Click()
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name = "データのみ印刷用扶養控除申告書.xls" Then
            wb.Activate
            Worksheets("扶養控除").Cells(1, 1).Value = Nendo
            Worksheets("扶養控除").Cells(5, 8).Value = ThisWorkbook.Worksheets(Ac).Cells(5, 8).Value
            Windows("データのみ印刷用扶養控除申告書.xls").Visible = True
            Unload Me
            Exit Sub
        End If
    Next
    Label37.Visible = True
    DoEvents
    Application.ScreenUpdating = False
    Workbooks.Open ThisWorkbook.Path & "\データのみ印刷用扶養控除申告書.xls"
    Worksheets("扶養控除").Cells(1, 1).Value = Nendo
    Worksheets("扶養控除").Cells(5, 8).Value = ThisWorkbook.Worksheets(Ac).Cells(5, 8).Value
    Windows("データのみ印刷用扶養控除申告書.xls").Visible = True
    Call データのみ初期処理
    Unload Me
End Sub

Private Sub OptionButton1_Click()
    Dim i As Long
    Dim n As Long
    n = 0
    ListBox2.Clear
    For i = 0 To ListBox1.ListCount - 1
        If Left(ListBox1.List(i, 0), 1) = "　" Then
            ListBox2.AddItem i + 開始行 '行
            ListBox2.List(n, 1) = ListBox1.List(i, 0)
            n = n + 1
        End If
    Next
End Sub
Private Sub OptionButton2_Click()
    Dim i As Long
    Dim n As Long
    n = 0
    ListBox2.Clear
    For i = 0 To ListBox1.ListCount - 1
        If Left(ListBox1.List(i, 0), 1) = "退" Then
            ListBox2.AddItem i + 開始行 '行
            ListBox2.List(n, 1) = ListBox1.List(i, 0)
            n = n + 1
        End If
    Next
End Sub
Private Sub OptionButton3_Click()
    Dim i As Long
    Dim n As Long
    n = 0
    ListBox2.Clear
    For i = 0 To ListBox1.ListCount - 1
        ListBox2.AddItem i + 開始行 '行
        ListBox2.List(n, 1) = ListBox1.List(i, 0)
        n = n + 1
    Next
End Sub

Private Sub UserForm_Activate()
    Dim i As Long
    Dim Fn As String
    Dim MyD As String
    Ac = ActiveSheet.Name
    If ActiveWorkbook.Name = "データのみ印刷用扶養控除申告書.xls" Then
        Nendo = Worksheets("扶養控除").Cells(1, 1).Value
        Else
        If Ac = "扶養控除前年" Then
            Nendo = Val(年度) - 1
            CommandButton9.Enabled = False '前年分の直接印刷はできない
            'YBNO 29255  ito 20151026
            'Label59.Visible = False
            Label59.Visible = True
            CheckBox4.Enabled = False
            Label54.Enabled = False
            CheckBox10.Visible = False  'YB29337 fuku 20151104
        Else
            Nendo = Val(年度)
        End If
    End If
    MultiPage1.Value = 0
    If ThisWorkbook.Worksheets("DATA").Cells(1, 2).Value = 4 Then '20141007 titti
        Label56.Visible = False
        CommandButton11.Visible = False
        MultiPage1.Pages(1).Visible = False
        MultiPage1.Pages(2).Visible = False
        MultiPage1.Pages(3).Visible = False
    End If
'20121017 kon
    Label53.Caption = Format(DateValue(Nendo & "/1/1"), "ggge年分")
    Label54.Caption = Format(DateValue(Val(Nendo - 1) & "/1/1"), "ggge年分")

'    Label53.Caption = Format(DateValue(Nendo + 1 & "/1/1"), "ggge年分")
'    Label54.Caption = Format(DateValue(Val(年度) & "/1/1"), "ggge年分")
    
    With Sj
        '１はCells給与、２は台帳
        If ThisWorkbook.Worksheets("DATA").Cells(1, 2).Value = 1 Or ThisWorkbook.Worksheets("DATA").Cells(1, 2).Value = 2 Or ThisWorkbook.Worksheets("DATA").Cells(1, 2).Value = 4 Then
            開始行 = 6
            For i = 開始行 To .Cells(50000, 2).End(xlUp).Row
                If ThisWorkbook.Worksheets("DATA").Cells(1, 2).Value >= 2 Then
                    MyD = IIf(IsDate(.Cells(i, 15).Value), "退 ", "　 ") & Format(.Cells(i, 2).Value, "000000") & " " & .Cells(i, 5).Value & " " & .Cells(i, 6).Value  '台帳氏名
                    Else
                    MyD = IIf(Trim(.Cells(i, 52).Value) <> "", "退 ", "　 ") & Format(.Cells(i, 2).Value, "000000") & " " & .Cells(i, 3).Value  'Cells給与氏名
                End If
                ListBox1.AddItem MyD '氏名

            Next
        '単体
        ElseIf ThisWorkbook.Worksheets("DATA").Cells(1, 2).Value = 3 Then
            開始行 = 6
            For i = 開始行 To .Cells(50000, 2).End(xlUp).Row
                ListBox1.AddItem "　 " & .Cells(i, 2).Text & " " & .Cells(i, 3).Value '氏名
            Next
        Else
            開始行 = 2 '労務ノート
            For i = 開始行 To .Cells(50000, 2).End(xlUp).Row
                ListBox1.AddItem IIf(IsDate(.Cells(i, 7).Value), "退 ", "　 ") & Format(Val(.Cells(i, 1).Value), "000000") & " " & .Cells(i, 2).Value  '20111101　重
            Next
        End If
    End With
   OptionButton1.Value = True '在職者を表示
    With ThisWorkbook.Worksheets("DATA")
        If .Cells(1, 2).Value = 1 Or .Cells(1, 2).Value = 2 Then 'Cells給与、台帳
            Fn = Left(.Cells(1, 1).Value, Len(.Cells(1, 1).Value) - 6)
            Label48.Caption = ThisWorkbook.Path & "\扶養控除申告書\" & Nendo & "\" & Fn
        ElseIf .Cells(1, 2).Value = 3 Then
            Label58.Visible = True
            CommandButton12.Visible = True
            Label48.Caption = ThisWorkbook.Path & "\扶養控除申告書\" & Nendo
        
        End If
    End With
End Sub
Private Sub UserForm_Initialize()
    Me.Caption = "扶養控除申告書の作成（" & Trim(Cells(5, 8).Value) & "用）"
    If ActiveWorkbook.Name = "データのみ印刷用扶養控除申告書.xls" Then
        MultiPage1.Page5.Visible = False
        MultiPage1.Page6.Visible = False
        MultiPage1.Page7.Visible = False
        MultiPage1.Page8.Visible = True
    End If

End Sub

Attribute VB_Name = "社員情報入力"
Attribute VB_Base = "0{53A5982A-1A38-4466-94C7-331A119F8D55}{CDA178F8-C603-4317-A00C-F4D1743DA8F6}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False




Option Explicit

Private Sub UserForm_Activate()
    Dim fName As String
    
    fName = ActiveWorkbook.Name
    With Workbooks("社員情報.xls").Worksheets("会社情報")
        TextBox1.Value = .Cells(3, 3).Value  '会社名
        TextBox2.Value = .Cells(4, 3).Value  '所在地
        TextBox3.Value = .Cells(5, 3).Value '税務署
    End With

'    With Workbooks("社員情報.xls").Worksheets("会社情報")
'        TextBox1.ControlSource = .Cells(3, 3).Address(, , , True)
'        TextBox2.ControlSource = .Cells(4, 3).Address(, , , True)
'        TextBox3.ControlSource = .Cells(5, 3).Address(, , , True)
'    End With
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    
    With ThisWorkbook.Worksheets("扶養控除")
        .Cells(11, 8).Value = TextBox1.Value    '会社名
        .Cells(15, 8).Value = TextBox2.Value    '所在地
        .Cells(12, 2).Value = TextBox3.Value '税務署
    End With
    With ThisWorkbook.Worksheets("保険料控除")
        .Cells(6, 11).Value = TextBox1.Value    '会社名
        .Cells(8, 11).Value = TextBox2.Value    '所在地
        .Cells(8, 3).Value = TextBox3.Value '税務署
    End With
'20121019 kon
    With Workbooks("社員情報.xls").Worksheets("会社情報")
        .Cells(3, 3).Value = TextBox1.Value    '会社名
        .Cells(4, 3).Value = TextBox2.Value    '所在地
        .Cells(5, 3).Value = TextBox3.Value '税務署
    End With
    
    With ThisWorkbook.Worksheets("扶養控除前年")
        .Cells(6, 11).Value = TextBox1.Value    '会社名
        .Cells(8, 11).Value = TextBox2.Value    '所在地
        .Cells(8, 3).Value = TextBox3.Value '税務署
    End With


End Sub

Attribute VB_Name = "Module1"
'単体版以外は事業所名の名前をいれる　20101029 kon
'年度を替え忘れるので　 20111014 kon add
Option Explicit
Public Sj As Worksheet
Public Kj As Worksheet
Public Const 年度 As String = "2016" ' 2014年と2013年の扶養控除
Public da As String
Public kk As String
Sub Auto_Open()
'読込ファイルのシートは必ずクリアしてから出荷すること
'単体とCells給与の初期処理用
    With Worksheets("読込ファイル")
        If Right(.Cells(1, 1).Value, 6) = "kk.xls" Then
            Worksheets("DATA").Cells(1, 1).Value = .Cells(1, 1).Value 'Cells給与
            Cells給与初期処理
        Else
            Application.ScreenUpdating = False
            Workbooks.Open ThisWorkbook.Path & "\社員情報.xls" '単体用"
            ActiveWindow.Visible = False
            ThisWorkbook.Activate
            ActiveWindow.Visible = True
            Call シート処理
            Sheets("扶養控除").Select
            With Workbooks("社員情報.xls").Worksheets("会社情報")
                Cells(7, 8).Value = .Cells(3, 3).Value   '会社名
                Cells(12, 8).Value = .Cells(4, 3).Value   '所在地
                Cells(8, 2).Value = .Cells(5, 3).Value '税務署
                Worksheets("扶養控除前年").Cells(11, 8).Value = .Cells(3, 3).Value   '会社名
                Worksheets("扶養控除前年").Cells(15, 8).Value = .Cells(4, 3).Value   '所在地
                Worksheets("扶養控除前年").Cells(12, 2).Value = .Cells(5, 3).Value '税務署
                Worksheets("保険料控除").Cells(6, 11).Value = .Cells(3, 3).Value
                Worksheets("保険料控除").Cells(8, 11).Value = .Cells(4, 3).Value
                Worksheets("保険料控除").Cells(8, 3).Value = .Cells(5, 3).Value  '税務署
            End With
            Worksheets("DATA").Cells(1, 2).Value = 3 '単体
        End If
    End With
End Sub
Sub 初期処理()
    Dim TextFilename As String
    Dim MyStr As String
    If Right(Worksheets("DATA").Cells(1, 1).Value, 6) = "da.xls" Then
        Call 台帳初期処理
        Exit Sub
    ElseIf Right(Worksheets("DATA").Cells(1, 1).Value, 6) = "kk.xls" Then
        Call Cells給与初期処理
        Exit Sub
    ElseIf Worksheets("DATA").Cells(1, 1).Value = "rmKozin.xlsm" Then
        Call 新ろうむノート初期処理
        Exit Sub
        
        Worksheets("DATA").Cells(1, 1).Value = ""
    End If
    Call シート処理
    Set Kj = Workbooks("社員情報.xls").Worksheets("会社情報")
    Sheets("扶養控除").Select
    ActiveWindow.DisplayWorkbookTabs = False
    Cells(7, 8).Value = Kj.Cells(3, 2).Value   '会社名
    Cells(12, 8).Value = Kj.Cells(5, 2).Value    '所在地
    Cells(8, 2).Value = Kj.Cells(20, 2).Value '税務署
    Worksheets("扶養控除前年").Cells(11, 8).Value = Kj.Cells(3, 2).Value   '会社名
    Worksheets("扶養控除前年").Cells(15, 8).Value = Kj.Cells(5, 2).Value    '所在地
    Worksheets("扶養控除前年").Cells(12, 2).Value = Kj.Cells(20, 2).Value   '税務署
    Worksheets("保険料控除").Cells(6, 11).Value = Kj.Cells(3, 2).Value
    Worksheets("保険料控除").Cells(8, 11).Value = Kj.Cells(5, 2).Value
    Worksheets("保険料控除").Cells(8, 3).Value = Kj.Cells(20, 2).Value  '税務署

    Cells(2, 3).Select
    Application.ScreenUpdating = True
End Sub
Private Sub シート処理()
    Dim s As Worksheet
    For Each s In Worksheets
        With s
            .Activate
            .EnableSelection = xlUnlockedCells
            .Protect UserInterfaceOnly:=True
            ActiveWindow.DisplayHeadings = False
        End With
    Next
    ActiveWindow.DisplayWorkbookTabs = False
End Sub
Sub 新ろうむノート初期処理()
    da = Worksheets("DATA").Cells(1, 1).Value
    Call シート処理
    Sheets("扶養控除").Select
    With Workbooks(da).Worksheets("info")
        Cells(8, 2).Value = .Cells(22, 2).Value   '税務署
'        Cells(17, 8).Value = .Cells(2, 2).Value   '会社名
        Cells(7, 8).Value = .Cells(2, 2).Value   '会社名 20151027 ishikawa
        Cells(12, 8).Value = .Cells(21, 2).Value  '所在地
        Worksheets("扶養控除前年").Cells(11, 8).Value = .Cells(2, 2).Value     '会社名
        Worksheets("扶養控除前年").Cells(15, 8).Value = .Cells(21, 2).Value      '所在地
        Worksheets("保険料控除").Cells(6, 11).Value = .Cells(2, 2).Value
        Worksheets("保険料控除").Cells(8, 11).Value = .Cells(21, 2).Value
        Worksheets("扶養控除前年").Cells(12, 2).Value = .Cells(22, 2).Value     '所在地
        Worksheets("保険料控除").Cells(8, 3).Value = .Cells(22, 2).Value '税務署
    End With
    Worksheets("DATA").Cells(1, 2).Value = 4  '台帳印
    Application.ScreenUpdating = True
End Sub

Sub 台帳初期処理()
    da = Worksheets("DATA").Cells(1, 1).Value
    Sheets("扶養控除").Select
    With Workbooks(da).Worksheets("会社情報")
        Cells(7, 8).Value = .Cells(8, 2).Value   '会社名
        Cells(12, 8).Value = .Cells(10, 2).Value  '所在地
        Worksheets("扶養控除前年").Cells(11, 8).Value = .Cells(8, 2).Value     '会社名
        Worksheets("扶養控除前年").Cells(15, 8).Value = .Cells(10, 2).Value      '所在地
        Worksheets("保険料控除").Cells(6, 11).Value = .Cells(8, 2).Value
        Worksheets("保険料控除").Cells(8, 11).Value = .Cells(10, 2).Value
    End With
    Worksheets("DATA").Cells(1, 2).Value = 2  '台帳印
    Application.ScreenUpdating = True
End Sub
Sub Cells給与初期処理()
    Dim MyStr As String
    Dim i As Long
    MyStr = ""
    kk = Worksheets("DATA").Cells(1, 1).Value
    Call シート処理
    Sheets("扶養控除").Select
    kk = Left(kk, Len(kk) - 6)

    If Dir(ThisWorkbook.Path & "\MyTool\JSoukatu" & kk & ".dat") <> "" Then
        Open ThisWorkbook.Path & "\MyTool\JSoukatu" & kk & ".dat" For Input As #1
            For i = 1 To 9
                Input #1, MyStr '9番目に管轄税務署が入っている
            Next
        Close #1
    End If
    kk = Worksheets("DATA").Cells(1, 1).Value
    With Workbooks(kk).Worksheets("基本項目")
         Cells(8, 2).Value = MyStr   '税務署
         Cells(7, 8).Value = .Cells(4, 3).Value   '会社名
         Cells(12, 8).Value = .Cells(9, 3).Value  '所在地
        Worksheets("扶養控除前年").Cells(11, 8).Value = .Cells(4, 3).Value    '会社名
        Worksheets("扶養控除前年").Cells(15, 8).Value = .Cells(9, 3).Value    '所在地
        Worksheets("扶養控除前年").Cells(12, 2).Value = MyStr      '所在地
        
        Worksheets("保険料控除").Cells(8, 3).Value = MyStr  '税務署
        Worksheets("保険料控除").Cells(6, 11).Value = .Cells(4, 3).Value
        Worksheets("保険料控除").Cells(8, 11).Value = .Cells(9, 3).Value
    End With
    Worksheets("DATA").Cells(1, 2).Value = 1  'Cells給与印
    Application.ScreenUpdating = True
End Sub
Sub 前年へ()
Sheets("扶養控除前年").Select
Range("A1").Select
End Sub
Sub 作成へ()
    With ThisWorkbook.Worksheets("DATA").Cells(1, 2)
        If .Value = 1 Or .Value = 2 Then 'Cells給与または台帳
            If ThisWorkbook.Worksheets("DATA").Cells(1, 2).Value = 2 Then '台帳
                da = ThisWorkbook.Worksheets("DATA").Cells(1, 1).Value
                Set Sj = Workbooks(da).Worksheets("個人情報")
                Set Kj = Workbooks(da).Worksheets("会社情報")
                Else
                kk = ThisWorkbook.Worksheets("DATA").Cells(1, 1).Value 'Cells給与
                Set Sj = Workbooks(kk).Worksheets("個人情報")
                Set Kj = Workbooks(kk).Worksheets("基本項目")
'                作成F.Label50.Visible = True 'Cells給与では扶養親族をセットできない旨のメッセージ表示
                作成F.Label51.Visible = True
            End If
        ElseIf .Value = 3 Then  '単体
            Set Sj = Workbooks("社員情報.xls").Worksheets("個人情報")
            Set Kj = Workbooks("社員情報.xls").Worksheets("会社情報")
'            作成F.CommandButton10.Visible = True
'            作成F.Label47.Visible = True
        ElseIf .Value = 4 Then  '新ろうむノート
            Set Sj = Workbooks("rmKozin.xlsm").Worksheets("kozin")
            Set Kj = Workbooks("rmKozin.xlsm").Worksheets("info")
        
        Else
            Set Sj = Workbooks("社員情報.xls").Worksheets("個人情報") '労務ノート
            Set Kj = Workbooks("社員情報.xls").Worksheets("会社情報")
        End If
    作成F.Show 0
    End With
End Sub

Sub 印刷設定保存()
    If ActiveWorkbook.ReadOnly = True Then
    MsgBox "このファイルは読み取り専用で開かれているため保存することができません。", 16, "保存"
    Exit Sub
    End If
    If MsgBox("この設定を保存しますか？", 4 + 32, "保存") <> 6 Then Exit Sub
    Application.DisplayAlerts = False
    
    Sheets("保険料控除").Select
    Range("C6:AR8").Value = ""
    Cells(1, 1).Select
    Sheets("扶養控除").Select
    'YBNO 29234  ito 20151026
    'Range("B11:AG52").Value = ""
    Range("B7:AI52").Value = ""
    Cells(1, 1).Select

'    Worksheets("扶養控除").Cells(1, 1).Value = Workbooks("扶養控除申告書.xls").Worksheets("扶養控除").Cells(1, 1).Value
    Worksheets("扶養控除").Cells(5, 8).Value = ThisWorkbook.Worksheets("扶養控除").Cells(5, 8).Value
    Windows("データのみ印刷用扶養控除申告書.xls").Visible = True
    Call データのみ初期処理
    
    ActiveWorkbook.Save
    MsgBox "保存しました。", 64, "保存"
    Application.DisplayAlerts = True
End Sub

Sub 閉じる()
    On Error Resume Next
    Workbooks("データのみ印刷用扶養控除申告書.xls").Close False
    On Error GoTo 0
    If Worksheets("DATA").Cells(1, 2).Value = 2 Then
        Application.Run "DaMenu.xls!End1"
    ElseIf Worksheets("DATA").Cells(1, 2).Value = 1 Then
        Application.Run "Cells給与.xls!End1"
    ElseIf Worksheets("DATA").Cells(1, 2).Value = 3 Then '単体
        If MsgBox("終了しますか？", 4 + 32, "終了") <> 6 Then Exit Sub
        On Error Resume Next
        Workbooks("社員情報.xls").Close False
        Call End1
    ElseIf Worksheets("DATA").Cells(1, 2).Value = 4 Then
        Application.Run "ろうむノート.xlsm!閉じる"
    Else
        Application.Run "ろうむノート.xls!閉じる"
    End If
End Sub
Sub End1()
    Application.OnTime Now + TimeValue("00:00:01"), "End2"
End Sub
Sub End2()
    ActiveWorkbook.Close False
…