Malicious Office (OLE) — malware analysis report

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


Attribute VB_Name = "印刷F"
Attribute VB_Base = "0{235AA431-ED30-45CD-855E-E2492EE751BF}{86629EDB-AD6D-424C-A567-661D10EC29B2}"
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 Ty As String
Private Sub CommandButton1_Click()
    Dim Hani As String
    If CheckBox1.Value = False And CheckBox2.Value = False Then
        MsgBox "「正」または「副」にチェックを入れて実行してください。", 16, aaa
        Exit Sub
    End If
    Select Case ActiveSheet.Name
        Case "第105号の2"
            Hani = "D4"
        Case "第105号の3"
            Hani = "D4"
        Case "第105号の4"
            Hani = "E3"
        Case "支給申請書"
            Hani = "R5"
        Case "残業実績申立書"
            Hani = "D3"
    End Select
    
    If MsgBox("プリンタの準備はいいですか？", 4 + 32, "印刷") <> 6 Then Exit Sub
    Application.ScreenUpdating = False
    If CheckBox1.Value = True Then
        Range(Hani).Value = "（正）"
        DoEvents
        ActiveSheet.PrintOut
    End If
    If CheckBox2.Value = True Then
        Range(Hani).Value = "（副）"
        DoEvents
        ActiveSheet.PrintOut
    End If
    Range(Hani).Value = "（正・副）"
    Application.ScreenUpdating = True
    Unload Me

End Sub

Private Sub CommandButton2_Click()
    If MsgBox("プリンタの準備はいいですか？", 4 + 32, "印刷") <> 6 Then Exit Sub
    Application.ScreenUpdating = False
    ActiveSheet.PrintOut Copies:=Val(ComboBox1.Value)
    Workbooks(Ty).Worksheets("DATA1").Cells(16, 3).Value = ComboBox1.Value
    Application.ScreenUpdating = True
    Unload Me
End Sub
Private Sub UserForm_Activate()
    Ty = ThisWorkbook.Worksheets("MENU").Cells(2, 7).Value & "中安金.xls"
    '20091212 重
    MultiPage1.PAGE1.Visible = False
    If ActiveSheet.Name = "残業実績申立書" Or ActiveSheet.Name = "第105号の3" Or ActiveSheet.Name = "第105号の4" Then
        MultiPage1.PAGE1.Visible = True
    End If
        ComboBox1.AddItem 1
        ComboBox1.AddItem 2
        ComboBox1.AddItem 3
        ComboBox1.ListIndex = 0
        ComboBox1.Value = Workbooks(Ty).Worksheets("DATA1").Cells(16, 3).Value
End Sub



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
Attribute VB_Control = "CommandButton1, 2077, 0, MSForms, CommandButton"
Option Explicit

Private Sub CommandButton1_Click()
    Call 終了へ
End Sub

Attribute VB_Name = "Sheet15"
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 = "Module1"
'************************
'修正履歴：
'Excel2000のSP3未満で保存し、開くときにオートメーションエラー
'    が表示されるため　20090318 kon
'雇用維持事業主申告書の実施計画表からの読込が読み込まれなかった 20090410 kon
'5号の3でページ数が正しく表示されなかったため修正　20090625 kon
'休業教育訓練実施一覧表のカレンダー部分や賃金締め切り期間をその都度再読み込みするように変更　20090717 kon
'バージョンアップ発売前の修正　20091214 kon
'１号の（１）休業実施計画届で休業予定日、１日目と２日目の間の　、　が抜けている為修正。　20100208 kon
'バージョンアップが行われないので修正　 20100421 kon
'単体のバージョンアップを追加　         20100426 kon
'書式のエラーを修正するため変更、台帳では、４月版で対応していなかったので原本だけ修正
'　 被保険者数のフォームも文言を変更しています。      20100514 kon
'Excel2010対応 様式92号追加と5号の1の変更                                          20101008 kon
'モジュール入れ替えではボタンが入れ替わってしまうため修正　20101028 kon
'2009年12月のバージョンアップが、予定表~の読込をするともう一度2009年12月のバージョンアップを行ってしまう　20101130 kon
'支給申請書で改行が正しくされなかったため修正　20101201 kon
'2010年12月様式対応                         20101214 kon
'2011年3月様式の追加    20110322 kon
'************************
Option Explicit
Public Const aaa As String = "中安金"
Sub Auto_Open()
    Dim da As String '単体
    Application.ScreenUpdating = False
    シート処理
    Worksheets("DATA").Cells(1, 1).Value = "" '単体版は空欄
    Sheets("MENU").Select
    ActiveSheet.Shapes("YOMIKOMI").Visible = True
    Cells(2, 7).Value = ""
    Cells(2, 2).Select
    Application.ScreenUpdating = True
End Sub

Sub 初期処理()
    Dim da As String
    Application.ScreenUpdating = False
    シート処理
    Sheets("MENU").Select
    ActiveSheet.Shapes("YOMIKOMI").Visible = False
    Cells(2, 2).Select
    If Dir(ThisWorkbook.Path & "\中安金", 16) = "" Then MkDir ThisWorkbook.Path & "\中安金" '中安金フォルダがなかったら作成する
    da = ThisWorkbook.Worksheets("DATA").Cells(1, 1).Value
    da = Left(da, Len(da) - 6) & "中安金.xls"
    If Dir(ThisWorkbook.Path & "\中安金\" & da) = "" Then '初めての起動だったら原本ファイルから作成する
        FileCopy ThisWorkbook.Path & "\中安金.xls", ThisWorkbook.Path & "\中安金\" & da
    End If
    Workbooks.Open ThisWorkbook.Path & "\中安金\" & da
    シート処理
    If Worksheets.Count < 21 Then
        ThisWorkbook.Activate
        Cells(3, 3).Value = "バージョンアップを実行しています。しばらくお待ちください・・・"
        Application.ScreenUpdating = True
        Application.ScreenUpdating = False
        Workbooks(da).Activate
        バージョンアップ
    End If
    ThisWorkbook.Activate
    Cells(2, 7).Value = Left(da, Len(da) - 7)
    If Cells(3, 3).Value <> "" Then
        MsgBox "バージョンアップ（「雇用維持事業主申告書」「労働者派遣契約に係る契約期間遵守証明書」の追加）が終了しました。", 64, aaa
        Cells(3, 3).Value = ""
    End If
    Application.ScreenUpdating = True
    If Workbooks(da).Worksheets("休業等対象者").Cells(5, 7).Value <> "障害の有無" Then
        UP200907.Show
        Application.ScreenUpdating = True
        MsgBox "バージョンアップ2009年7月版が終了しました。", 64, aaa
    End If
    If Workbooks(da).Worksheets("結果").Cells(11, 39).Value <> "短時間休業" Then '200912のアップ
        UP200912.Show
        Application.ScreenUpdating = True
        MsgBox "バージョンアップ2009年12月版が終了しました。", 64, aaa
    End If
'20100421 kon
'    If Workbooks(da).Worksheets("実施計画届").Cells(52, 3).Value = "※" Then '201004のアップ 20100420 重
'20100428 kon
'    If Workbooks(da).Worksheets("実施計画届").Cells(52, 3).Value <> "※" Then '201004のアップ 20100420 重
    
    If Trim(Workbooks(da).Worksheets("実施計画届").Cells(52, 3).Value) <> "※" Then '201004のアップ 20100420 重
        UP201004.Show
        Application.ScreenUpdating = True
        MsgBox "バージョンアップ2010年4月版が終了しました。", 64, aaa
    End If
'20101008 kon
    If Trim(Workbooks(da).Worksheets("会社基本情報").Cells(3, 11).Value) = "" Then  '201011のアップ 20101008 KON
        Up201011.Show
        Application.ScreenUpdating = True
        MsgBox "バージョンアップ2010年11月版が終了しました。", 64, aaa
'20101208 kon
    Else
    
        '2009年12月版の時のエラーのため、バージョンが戻ってしまう場合があるので強制的に変更
        '支給申請書の様式が変わったらやらない
        Application.ScreenUpdating = False
        Workbooks(da).Worksheets("支給申請書").Cells(8, 3).Value = "雇用調整助成金／中小企業緊急雇用安定助成金（休業・教育訓練）の支給を受けたいので、" & vbLf _
                        & "裏面記載の1､2､4の注意を了解し､3の不支給要件に該当しないことを確認の上､次のとおり申請します｡" & vbLf _
                        & "なお、この申請書の記載事項に係る確認を安定所（労働局）が行う場合には協力します。"
         Workbooks(da).Activate
         Worksheets("支給申請書").Select
         Rows("8:9").Select
        Selection.RowHeight = 24.75
        Range("A1").Select
        シート処理
        ThisWorkbook.Activate
        Application.ScreenUpdating = True
        
    End If
    '2010年12月アップ　　20101214 kon
    Application.ScreenUpdating = False
    If Workbooks(da).Worksheets("会社基本情報").Cells(3, 11).Value = "3.00.11" Then
        Workbooks(da).Activate
        Up310
        Workbooks(da).Worksheets("会社基本情報").Cells(3, 11).Value = "3.10"
        MsgBox "バージョンアップ2010年12月版が終了しました。", 64, aaa
    End If
    '2011年3月アップ　　20110322 kon
    Application.ScreenUpdating = True
    Application.ScreenUpdating = False
    If Workbooks(da).Worksheets("会社基本情報").Cells(3, 11).Value = "3.1" Then
        Workbooks(da).Activate
        Up320
        Workbooks(da).Worksheets("会社基本情報").Cells(3, 11).Value = "3.2"
        MsgBox "バージョンアップ2011年03月版が終了しました。", 64, aaa
    End If
    
    Application.ScreenUpdating = True
End Sub
'　支給申請確認書・雇用調整実施事業所の事業活動の状況に関する申出書（円高の影響用）の追加
Sub Up310()
    
    Dim Aw As String
    Dim sCnt
    Application.DisplayAlerts = False
'    Application.ScreenUpdating = False
    
    Aw = ActiveWorkbook.Name
    
    sCnt = ActiveWorkbook.Sheets.Count
    Workbooks.Open ThisWorkbook.Path & "\Up310.xls"
    Windows("Up310.xls").Activate
    Sheets(Array("支給申請確認書", "円高の影響")).Move Before:=Workbooks(Aw).Sheets(sCnt)
    Workbooks(Aw).Activate
    
    With Workbooks(Aw).Worksheets("会社基本情報")
'支給申請確認書
        Worksheets("支給申請確認書").Select
         '事業所
        Cells(18, 11).Value = .Cells(6, 4).Value
        Cells(18, 12).Value = .Cells(7, 4).Value
        Cells(19, 11).Value = .Cells(8, 4).Value
        Cells(20, 11).Value = .Cells(9, 4).Value
        
        '社労士
        Cells(28, 13).Value = .Cells(12, 4).Value
        Cells(28, 14).Value = .Cells(13, 4).Value
        Cells(29, 13).Value = .Cells(14, 4).Value
        Cells(30, 13).Value = .Cells(15, 4).Value
        
        '管轄
        Cells(28, 3).Value = .Cells(29, 4).Value
        Cells(29, 3).Value = .Cells(30, 4).Value
        '日付
        Cells(18, 3).Value = Now()
        Cells(1, 1).Select
'円高の影響
        Worksheets("円高の影響").Select
         '事業所
        Cells(7, 9).Value = .Cells(6, 4).Value
        Cells(7, 12).Value = .Cells(7, 4).Value
        Cells(8, 10).Value = .Cells(8, 4).Value
        Cells(9, 10).Value = .Cells(9, 4).Value
        
        '社労士
        Cells(15, 12).Value = .Cells(12, 4).Value
        Cells(15, 16).Value = .Cells(13, 4).Value
        Cells(16, 13).Value = .Cells(14, 4).Value
        Cells(17, 13).Value = .Cells(15, 4).Value
        
        '管轄
        Cells(15, 2).Value = .Cells(29, 4).Value
        Cells(16, 2).Value = .Cells(30, 4).Value
        '日付
        Cells(7, 2).Value = Now()
        Cells(1, 1).Select
    End With
    Worksheets("会社基本情報").Select
    ThisWorkbook.Activate
    Application.DisplayAlerts = True
'    Application.ScreenUpdating = True
    On Error Resume Next 'エクセル2007用
    ActiveWorkbook.ChangeLink Name:=ThisWorkbook.Path & "\Up310.xls", NewName:=Aw, Type:=xlExcelLinks

End Sub
'　事業活動の状況に関する申出書（地震）の追加
Sub Up320()
    
    Dim Aw As String
    Dim sCnt
    Application.DisplayAlerts = False
    
    Aw = ActiveWorkbook.Name
    
    sCnt = ActiveWorkbook.Sheets.Count
    Workbooks.Open ThisWorkbook.Path & "\Up320.xls"
    Windows("Up320.xls").Activate
    Sheets("申出書震災").Move Before:=Workbooks(Aw).Sheets(sCnt)
    Workbooks(Aw).Activate
    
    With Workbooks(Aw).Worksheets("会社基本情報")
'支給申請確認書
        Worksheets("申出書震災").Select
        '事業所
        '〒
        Cells(7, 10).Value = .Cells(6, 4).Value
        '住所
        Cells(7, 12).Value = .Cells(7, 4).Value
        '名称
        Cells(8, 10).Value = .Cells(8, 4).Value
        '代理人氏名
        Cells(9, 10).Value = .Cells(9, 4).Value
        
        '社労士
        '郵便番号
        Cells(15, 14).Value = .Cells(12, 4).Value
        '住所
        Cells(15, 16).Value = .Cells(13, 4).Value
        '名称
        Cells(16, 13).Value = .Cells(14, 4).Value
        '氏名
        Cells(17, 13).Value = .Cells(15, 4).Value
        
        '管轄
        Cells(15, 2).Value = .Cells(29, 4).Value
        Cells(16, 2).Value = .Cells(30, 4).Value
        '日付
        Cells(7, 2).Value = Now()
        Cells(1, 1).Select
    End With
    Worksheets("会社基本情報").Select
    ThisWorkbook.Activate
    Application.DisplayAlerts = True
'    Application.ScreenUpdating = True
    On Error Resume Next 'エクセル2007用
    ActiveWorkbook.ChangeLink Name:=ThisWorkbook.Path & "\Up320.xls", NewName:=Aw, Type:=xlExcelLinks

End Sub

Sub バージョンアップ()
    '上乗せ分のシートがあるか、なければ２つのシートを追加する
    Dim Aw As String
    Aw = ActiveWorkbook.Name
    Workbooks.Open ThisWorkbook.Path & "\Tyuankin.xls"
    Windows("Tyuankin.xls").Activate
    Sheets(Array("雇用維持事業主申告書", "派遣契約期間遵守証明書")).Move Before:=Workbooks(Aw).Sheets(20)
    Workbooks(Aw).Activate
    Sheets("予定").Select
    Range("AI6:AK6").Select
    Selection.UnMerge
    Columns("AK:AK").Select
    Selection.Locked = False
    Range("AI6:AK6").Select
    Range("AK6").Activate
    Selection.Merge
    Range("AF14").Select
    Range("L7").Font.ColorIndex = xlAutomatic
    Sheets("結果").Select
    Range("AI6:AK6").Select
    Selection.UnMerge
    Columns("AK:AK").Select
    Selection.Locked = False
    Range("AI6:AK6").Select
    Range("AK6").Activate
    Selection.Merge
    Range("AE12").Select
    Range("L7").Font.ColorIndex = xlAutomatic
    Sheets("第105号の4").Select
    Range("N12:N59").Select
    Selection.NumberFormatLocal = "G/標準"
    Range("A6").Select
    Sheets("第105号の2").Select
    Range("G21:H21").NumberFormatLocal = "# ??/??"
    Sheets("残業実績内訳表").Select
    Range("Q11").Select
    ActiveCell.FormulaR1C1 = "=RC[-5]-RC[-3]-RC[-1]"
    Range("M11:M42,O11:O42").Select
    Range("O42").Activate
    Selection.NumberFormatLocal = "G/標準"
    Range("O17").Select
    Sheets("残業実績申立書").Select
    Range("C41:M41").Select
    Selection.Locked = False
    Range("J60").Select
    Sheets("休業等対象者").Select
    Range("D6").Select
    Columns("D:D").ColumnWidth = 18.38
    Range("D6").Select
    Worksheets("会社基本情報").Select
    With Worksheets("雇用維持事業主申告書")
        .Cells(16, 37).Value = "〒" & Cells(6, 4).Value & " " & Cells(7, 4).Value
        .Cells(17, 37).Value = Cells(8, 4).Value
        .Cells(18, 37).Value = Cells(9, 4).Value
        .Cells(28, 42).Value = "〒" & Cells(12, 4).Value & " " & Cells(13, 4).Value
        .Cells(29, 42).Value = Cells(14, 4).Value
        .Cells(30, 42).Value = Cells(15, 4).Value
        .Cells(28, 3).Value = Cells(29, 4).Value
        .Cells(29, 3).Value = Cells(30, 4).Value
        .Cells(34, 13).Value = Cells(19, 4).Value
        .Cells(35, 13).Value = Cells(22, 4).Value
        .Cells(34, 42).Value = "〒" & Cells(18, 4).Value & " " & Cells(20, 4).Value
        .Cells(35, 42).Value = Cells(21, 4).Value
        .Cells(37, 7).Value = Cells(23, 4).Value
    End With
    With Worksheets("派遣契約期間遵守証明書")
        .Cells(15, 8).Value = Cells(19, 4).Value
    End With
    
    
    On Error Resume Next 'エクセル2007用
    ActiveWorkbook.ChangeLink Name:=ThisWorkbook.Path & "\Tyuankin.xls", NewName:=Aw, Type:=xlExcelLinks

End Sub
Sub 台帳からのデータ読込()
    Dim da As String
    da = ThisWorkbook.Worksheets("DATA").Cells(1, 1).Value
    If Right(da, 6) = "ta.xls" Then
        MsgBox "システムが「台帳版」ではないため実行できません。", 16, aaa
        Exit Sub
    End If
    If MsgBox("台帳から関連データを読込みますか？", 4 + 32, aaa) <> 6 Then Exit Sub
    Application.Calculation = xlCalculationManual
    With Workbooks(da).Worksheets("会社情報")
        Cells(6, 4).Value = .Cells(9, 2).Value
        Cells(7, 4).Value = .Cells(10, 2).Value
        Cells(8, 4).Value = .Cells(8, 2).Value
        Cells(9, 4).Value = .Cells(11, 2).Value & " " & .Cells(12, 2).Value
        Cells(18, 4).Value = .Cells(9, 2).Value
        Cells(19, 4).Value = .Cells(8, 2).Value
        Cells(20, 4).Value = .Cells(10, 2).Value
        Cells(21, 4).Value = .Cells(13, 2).Value
        Cells(22, 4).Value = .Cells(36, 2).Value
        Cells(23, 4).Value = ""
        Cells(24, 4).Value = .Cells(33, 2).Value
        Cells(26, 4).Value = .Cells(15, 2).Value
        Cells(27, 4).Value = .Cells(101, 2).Value
        Cells(29, 4).Value = .Cells(38, 2).Value
        Cells(30, 4).Value = .Cells(83, 2).Value
    End With
    With Workbooks("DaMenu.xls").Worksheets("標準報酬月額")
        Cells(12, 4).Value = .Cells(152, 7).Value
        Cells(13, 4).Value = .Cells(153, 7).Value
        Cells(14, 4).Value = .Cells(151, 7).Value
        Cells(15, 4).Value = .Cells(154, 7).Value
    End With
    With Workbooks(da).Worksheets("個人情報")
        Cells(25, 4).Value = WorksheetFunction.Count(.Columns(29)) - WorksheetFunction.Count(.Columns(30))
    End With
    Application.Calculation = xlCalculationAutomatic
    If MsgBox("OK !!" & Chr(10) & "「被保険者等数」は現在在職中の被保険者数を、「労働保険番号」は最初に登録されているデータを読込みました。" & Chr(10) & "相違する場合は変更してください。" & Chr(10) & Chr(10) & "次に「労働者代表」また「担当者職・氏名」を個人情報から読込みますか？", 4 + 32, aaa) <> 6 Then Exit Sub
    個人情報.Show
End Sub
Sub 対象者へ()
    Dim da As String
    da = ThisWorkbook.Worksheets("DATA").Cells(1, 1).Value
    If Right(da, 6) = "ta.xls" Then
        MsgBox "システムが「台帳版」ではないため実行できません。", 16, aaa
        Exit Sub
    End If
    対象者.Show
End Sub
Sub 並び替えへ()
並び替え.Show 0
End Sub
Sub シート処理()
    Dim s As Worksheet
    For Each s In Worksheets
        With s
            .Activate
            ActiveWindow.DisplayHeadings = False
            .EnableSelection = xlUnlockedCells
            .Protect UserInterfaceOnly:=True
        End With
    Next
    ActiveWindow.DisplayWorkbookTabs = True
End Sub
'Sub コンバートへ()
'コンバート.Show
'End Sub

Sub 基本へ()
基本.Show
End Sub
Sub 社員名()
社員名入力.Show
End Sub
Sub 指定へ()
指定.Show
End Sub
Sub 印刷へ()
    If Cells(12, 3).Value = "" Then
        MsgBox "印刷するデータがありません。", 16, aaa
        Exit Sub
    End If
    印刷.Show
End Sub
Sub クリア()
    If ActiveSheet.Name = "予定" Then
        If Cells(10, 4).Value <> Worksheets("結果").Cells(10, 4).Value Then   '結果表で現在データが読み込まれていなければ注意する
            If MsgBox("現在のデータは「結果表」で読み込まれていません。このまま実行すると「結果表」を作成することができませんがよろしいですか？", 4 + 48, aaa) <> 6 Then Exit Sub
        End If
    End If
    If MsgBox("データ部（所定休日、休業等の記号部分）をクリアしてもいいですか？", 4 + 32, "クリア") <> 6 Then Exit Sub
    Range("C7:AJ8").ClearContents
    Range("AK8").ClearContents
    Range("D12:AN" & Cells(10000, 3).End(xlUp).Row + 5).ClearContents
    Range("AM10:BR10").ClearContents
    MsgBox "OK", 64, aaa
End Sub
Sub MENUへ()
    Application.ScreenUpdating = False
    Sheets("MENU").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    Application.ScreenUpdating = True
End Sub
Sub HELPへ()
    Application.ScreenUpdating = False
    Sheets("HELP").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    Application.ScreenUpdating = True
End Sub
Sub 終了へ()
    Dim wb As Object, ブックの数 As Integer
    Dim 中安金ブック As Integer
    中安金ブック = 0
    ブックの数 = 0
    For Each wb In Application.Workbooks
        If UCase(wb.Name) Like "PERSONAL*" Then
            Else
            If wb.Name Like "*中安金*" Then 中安金ブック = 中安金ブック + 1
            ブックの数 = ブックの数 + 1
        End If
    Next
    If 中安金ブック = 0 Then '事情所ファイルが閉じられていたら
        If ブックの数 = 1 Then
            Application.DisplayAlerts = False
            Application.Quit
        Else
            ThisWorkbook.Close False
        End If
        Exit Sub
    End If
    終了.Show
End Sub

Sub 予定表の読込()
    予定表読込.Show
End Sub
Sub 出勤状況()
    MsgBox "シート上で直接休日出勤、有給休暇、欠勤等の出勤状況を入力（選択）してください。", 64, aaa
End Sub
Sub ファイル出力()
    If MsgBox("エクセルの新規ブックにこのシートを出力します。よろしいですか？", 4 + 32, aaa) <> 6 Then Exit Sub
    Application.ScreenUpdating = False
    Cells.Copy
    Range("E4").Select
    Workbooks.Add
    Cells.Select
    Cells.PasteSpecial Paste:=xlPasteValues
    Cells.PasteSpecial Paste:=xlPasteFormats
    Range("E4").Select
    ActiveWindow.DisplayGridlines = False
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    MsgBox "出力しました。適当な名前をつけて保存してください。", 64, aaa
End Sub

Sub 印刷ヘルプ()
If MsgBox("プリンタの準備はいいですか？", 4 + 32, "印刷") <> 6 Then Exit Sub
ActiveSheet.PrintOut
End Sub
Sub 印刷Fへ()
印刷F.Show
End Sub
Sub 様式105Fへ()
様式105.Show
End Sub
'Sub 作成についてへ()
'作成について.Show
'End Sub
Sub 受講者へ()
受講者.Show
End Sub
Sub 残業内訳へ()
残業内訳.Show
End Sub
Sub 休業協定へ()
休業協定.Show
End Sub

Sub 読み込みへ()
読込.Show
End Sub
Sub データ適用会社情報()
    If MsgBox("各シートにこの会社情報データを適用しますか？", 4 + 32, aaa) <> 6 Then Exit Sub
    Application.Calculation = xlCalculationManual
    With Worksheets("予定表")
        .Range("AF45").Value = Cells(7, 4).Value '事業主住所
        .Range("AF46").Value = Cells(8, 4).Value '名称
        .Range("AF47").Value = Cells(9, 4).Value '代表者
    End With
    With Worksheets("結果表")
        .Range("AF45").Value = Cells(7, 4).Value '事業主住所
        .Range("AF46").Value = Cells(8, 4).Value '名称
        .Range("AF47").Value = Cells(9, 4).Value '代表者
    End With
    With Worksheets("第105号の3")
        .Cells(40, 15).Value = Cells(8, 4).Value  '名称
        .Cells(41, 15).Value = Cells(9, 4).Value  '代表者
        .Cells(43, 15).Value = Cells(34, 4).Value '労働者代表
    End With
    With Worksheets("第105号の2")
        .Cells(8, 4).Value = Cells(19, 4).Value   '事業所名
        .Cells(8, 8).Value = Cells(22, 4).Value   '事業所番号
    End With
    With Worksheets("実施計画届")
        .Cells(8, 14).Value = Cells(6, 4).Value
        .Cells(8, 16).Value = Cells(7, 4).Value
        .Cells(9, 14).Value = Cells(8, 4).Value
        .Cells(10, 14).Value = Cells(9, 4).Value
        .Cells(16, 15).Value = Cells(12, 4).Value & " " & Cells(13, 4).Value
        .Cells(17, 15).Value = Cells(14, 4).Value
        .Cells(18, 15).Value = Cells(15, 4).Value
        .Cells(16, 3).Value = Cells(29, 4).Value
        .Cells(17, 4).Value = Cells(30, 4).Value
        .Cells(25, 6).Value = Cells(19, 4).Value
        .Cells(26, 6).Value = Cells(22, 4).Value
        .Cells(25, 16).Value = Cells(18, 4).Value & " " & Cells(20, 4).Value
        .Cells(26, 17).Value = Cells(21, 4).Value
        .Cells(28, 4).Value = Cells(23, 4).Value
        .Cells(28, 15).Value = Cells(24, 4).Value '20090630 sige
'        .Cells(28, 12).Value = Cells(24, 4).Value
'        .Cells(28, 19).Value = Cells(25, 4).Value
    End With
    With Worksheets("支給申請書")
        .Cells(10, 14).Value = "〒" & Cells(6, 4).Value & " " & Cells(7, 4).Value
        .Cells(11, 14).Value = Cells(8, 4).Value
        .Cells(12, 14).Value = Cells(9, 4).Value
        .Cells(19, 16).Value = "〒" & Cells(12, 4).Value & " " & Cells(13, 4).Value
        .Cells(20, 16).Value = Cells(14, 4).Value
        .Cells(21, 16).Value = Cells(15, 4).Value
        .Cells(19, 4).Value = Cells(29, 4).Value
        .Cells(20, 3).Value = Cells(30, 4).Value
        .Cells(23, 5).Value = Cells(19, 4).Value
        .Cells(25, 5).Value = Cells(22, 4).Value
        .Cells(26, 5).Value = Cells(27, 4).Value
        .Cells(23, 17).Value = Cells(18, 4).Value
        .Cells(24, 15).Value = Cells(20, 4).Value
        .Cells(26, 17).Value = Cells(21, 4).Value
        .Cells(27, 8).Value = Cells(23, 4).Value
        .Cells(28, 18).Value = Cells(26, 4).Value
        .Cells(30, 5).Value = Cells(24, 4).Value
        .Cells(30, 10).Value = Cells(25, 4).Value
        .Cells(40, 4).Value = Cells(8, 4).Value
    End With
    
    With Worksheets("雇用維持事業主申告書")
        .Cells(16, 37).Value = "〒" & Cells(6, 4).Value & " " & Cells(7, 4).Value
        .Cells(17, 37).Value = Cells(8, 4).Value
        .Cells(18, 37).Value = Cells(9, 4).Value
        .Cells(28, 42).Value = "〒" & Cells(12, 4).Value & " " & Cells(13, 4).Value
        .Cells(29, 42).Value = Cells(14, 4).Value
        .Cells(30, 42).Value = Cells(15, 4).Value
        .Cells(28, 3).Value = Cells(29, 4).Value
        .Cells(29, 3).Value = Cells(30, 4).Value
        .Cells(34, 13).Value = Cells(19, 4).Value
        .Cells(35, 13).Value = Cells(22, 4).Value
        .Cells(34, 42).Value = "〒" & Cells(18, 4).Value & " " & Cells(20, 4).Value
        .Cells(35, 42).Value = Cells(21, 4).Value
        .Cells(37, 7).Value = Cells(23, 4).Value
    End With
    
    With Worksheets("労働者選任届")
        .Cells(5, 2).Value = " 　　休業・教育訓練・出向の計画・実施の協定の取り決めに関する事項については " & Cells(8, 4).Value & " の全労働者又は過半数以上の労働者の総意を得て、代表者として選任されたことを届けます。"
        .Cells(12, 2).Value = Cells(8, 4).Value
        .Cells(13, 2).Value = Cells(9, 4).Value & "  殿"
        .Cells(16, 5).Value = Cells(34, 4).Value
        .Cells(15, 5).Value = Cells(35, 4).Value
    End With
    With Worksheets("休業協定書")
        .Cells(5, 2).Value = "   " & Cells(8, 4).Value & " と　" & Cells(8, 4).Value & "  従業員代表者　" & Cells(34, 4).Value & " とは、休業に関し下記のとおり協定する。"
        .Cells(38, 8).Value = Cells(8, 4).Value
        .Cells(40, 8).Value = Cells(8, 4).Value
        .Cells(39, 9).Value = Cells(9, 4).Value
        .Cells(41, 9).Value = "従業員代表　" & Cells(34, 4).Value
    End With
    With Worksheets("教育訓練協定書")
        .Cells(5, 2).Value = "   " & Cells(8, 4).Value & " と　" & Cells(8, 4).Value & "  従業員代表者　" & Cells(34, 4).Value & " とは、事業活動の縮小に伴う教育訓練の実施に関し下記のとおり協定する。"
        .Cells(11, 3).Value = Cells(8, 4).Value & " 内の実習工場とする。"
        .Cells(38, 8).Value = Cells(8, 4).Value
        .Cells(40, 8).Value = Cells(8, 4).Value
        .Cells(39, 9).Value = Cells(9, 4).Value
        .Cells(41, 9).Value = "従業員代表　" & Cells(34, 4).Value
    End With
    With Worksheets("委任状")
        .Cells(5, 2).Value = "   " & Cells(8, 4).Value & " の従業員は　" & Cells(34, 4).Value & " を従業員代表とすることに同意し、休業・教育訓練・出向の計画・実施に関する協定の一切の権限について委任します。"
    End With
    With Worksheets("雇用状況申出書")
        .Cells(7, 10).Value = Cells(6, 4).Value & " " & Cells(7, 4).Value
        .Cells(8, 10).Value = Cells(8, 4).Value
        .Cells(9, 10).Value = Cells(9, 4).Value
        .Cells(15, 14).Value = Cells(12, 4).Value & " " & Cells(13, 4).Value
        .Cells(16, 13).Value = Cells(14, 4).Value
        .Cells(17, 13).Value = Cells(15, 4).Value
        .Cells(15, 2).Value = Cells(29, 4).Value
        .Cells(16, 2).Value = Cells(30, 4).Value
    End With
    With Worksheets("残業実績申立書")
        .Cells(45, 7).Value = "〒" & Cells(6, 4).Value & " " & Cells(7, 4).Value
        .Cells(46, 7).Value = Cells(8, 4).Value
        .Cells(47, 7).Value = Cells(9, 4).Value
        .Cells(40, 3).Value = "内に　" & Cells(8, 4).Value & "　事業所内で行われた残業の実績であることを確認します。"
        .Cells(41, 3).Value = "なお、上記の残業に係る実績を証する書類は、" & Cells(30, 4).Value & "公共職業安定所長又は労働局長の求めに応じて提出する"
    End With
    With Worksheets("教育訓練受講証明書")
        .Cells(9, 6).Value = Cells(20, 4).Value
        .Cells(8, 6).Value = Cells(19, 4).Value
    End With
    With Worksheets("派遣契約期間遵守証明書")
        .Cells(15, 8).Value = Cells(19, 4).Value
    End With
    '20101214 kon
    '支給申請確認書
    With Worksheets("支給申請確認書")
         '事業所
        .Cells(18, 11).Value = Cells(6, 4).Value
        .Cells(18, 12).Value = Cells(7, 4).Value
        .Cells(19, 11).Value = Cells(8, 4).Value
        .Cells(20, 11).Value = Cells(9, 4).Value
        
        '社労士
        .Cells(28, 13).Value = Cells(12, 4).Value
        .Cells(28, 14).Value = Cells(13, 4).Value
        .Cells(29, 13).Value = Cells(14, 4).Value
        .Cells(30, 13).Value = Cells(15, 4).Value
        
        '管轄
        .Cells(28, 3).Value = Cells(29, 4).Value
        .Cells(29, 3).Value = Cells(30, 4).Value
    End With
'円高の影響
        
    With Worksheets("円高の影響")
         '事業所
        .Cells(7, 9).Value = Cells(6, 4).Value
        .Cells(7, 12).Value = Cells(7, 4).Value
        .Cells(8, 10).Value = Cells(8, 4).Value
        .Cells(9, 10).Value = Cells(9, 4).Value
        
        '社労士
        .Cells(15, 12).Value = Cells(12, 4).Value
        .Cells(15, 16).Value = Cells(13, 4).Value
        .Cells(16, 13).Value = Cells(14, 4).Value
        .Cells(17, 13).Value = Cells(15, 4).Value
        
        '管轄
        .Cells(15, 2).Value = Cells(29, 4).Value
        .Cells(16, 2).Value = Cells(30, 4).Value
    End With
'震災の影響
    With Worksheets("申出書震災")
         '事業所
        .Cells(7, 10).Value = Cells(6, 4).Value
        .Cells(7, 12).Value = Cells(7, 4).Value
        .Cells(8, 10).Value = Cells(8, 4).Value
        .Cells(9, 10).Value = Cells(9, 4).Value
        
        '社労士
        .Cells(15, 14).Value = Cells(12, 4).Value
        .Cells(15, 16).Value = Cells(13, 4).Value
        .Cells(16, 13).Value = Cells(14, 4).Value
        .Cells(17, 13).Value = Cells(15, 4).Value
        
        '管轄
        .Cells(15, 2).Value = Cells(29, 4).Value
        .Cells(16, 2).Value = Cells(30, 4).Value
    End With
    
    
    Application.Calculation = xlCalculationAutomatic
    MsgBox "適用しました。各シートで異なる場合は編集してください。", 64, aaa

End Sub
Sub 確認書()
    Dim file_name As Object
    Dim iCnt      As Integer
    Dim Toku As String
    
    Toku = ThisWorkbook.Worksheets("MENU").Cells(2, 7).Value
    If Toku = "" Then
        MsgBox "事業所のデータファイルが読み込まれていません。", 16, aaa
        Exit Sub
    End If
    Toku = Toku & "中安金.xls"
    
    iCnt = 0
    Application.ScreenUpdating = False
    For Each file_name In Windows
        If file_name.Caption = "支給申請確認書.xls" Then
            iCnt = 1
            Workbooks("支給申請確認書.xls").Activate
            Exit Sub
        End If
    Next
    If iCnt = 0 Then
        Workbooks.Open ThisWorkbook.Path & "\支給申請確認書.xls"
        シート処理
    End If
    Workbooks("支給申請確認書.xls").Activate
    
    With Workbooks(Toku).Worksheets("会社基本情報")
        '事業所
        Cells(16, 14).Value = .Cells(6, 4).Value
        Cells(16, 15).Value = .Cells(7, 4).Value
        Cells(17, 14).Value = .Cells(8, 4).Value
        Cells(18, 14).Value = .Cells(9, 4).Value
        
        '社労士
        Cells(25, 16).Value = .Cells(12, 4).Value
        Cells(25, 17).Value = .Cells(13, 4).Value
        Cells(26, 15).Value = .Cells(14, 4).Value
        Cells(27, 15).Value = .Cells(15, 4).Value
        
        '管轄
        Cells(25, 4).Value = .Cells(29, 4).Value
        Cells(26, 4).Value = .Cells(30, 4).Value
        
        '日付
        Cells(16, 4).Value = Now()
    End With


    Application.ScreenUpdating = True

End Sub

Sub 休業予定データ()
    Dim n As Integer
    Dim i As Integer
    Dim Hi As String
    Dim Nen As String
    Dim 年 As Integer
    Dim 年2 As Integer
    If ActiveSheet.CheckBoxes("Che").Value <> 1 Then
        Hi = "m月d日、"
        Nen = "ggge年m月d日"
        Else
        Hi = "m/d、"
        Nen = "ge/m/d、"
    End If
    
    Dim Kyugyo As String
    Dim Kyoiku As String
    Application.ScreenUpdating = False
    Kyugyo = ""
    Kyoiku = ""
    Range("D32:Y32,D34:I34,N34:S34,D37:Y37,C39:G39,N39:S39").ClearContents
    With Worksheets("予定")
        For i = 4 To 34
            If .Cells(7, i).Value > 0 Then
                If Kyugyo = "" Then
                Kyugyo = Kyugyo & Format(.Cells(10, i).Value, Nen) '年が変わったら年月日まで表示、それ以外は月日　200912　重
                年 = Year(.Cells(10, i).Value)
                Else
                    If 年 = Year(.Cells(10, i).Value) Then
'20100208 kon
'                        Kyugyo = Kyugyo & Format(.Cells(10, i).Value, Hi)
                        Kyugyo = IIf(Right(Kyugyo, 1) = "、", Kyugyo, Kyugyo & "、") & Format(.Cells(10, i).Value, Hi)
                    Else
'                        Kyugyo = Kyugyo & Format(.Cells(10, i).Value, Nen)
                        Kyugyo = IIf(Right(Kyugyo, 1) = "、", Kyugyo, Kyugyo & "、") & Format(.Cells(10, i).Value, Nen)
                        年 = Year(.Cells(10, i).Value)
                    End If
                End If
                
             End If
            If .Cells(8, i).Value > 0 Then
                If Kyoiku = "" Then
                Kyoiku = Kyoiku & Format(.Cells(10, i).Value, Nen)
                年 = Year(.Cells(10, i).Value)
                Else
                    If 年 = Year(.Cells(10, i).Value) Then
'                        Kyoiku = Kyoiku & Format(.Cells(10, i).Value, Hi)
                        Kyoiku = IIf(Right(Kyoiku, 1) = "、", Kyoiku, Kyoiku & "、") & Format(.Cells(10, i).Value, Hi)
                    Else
'                        Kyoiku = Kyoiku & Format(.Cells(10, i).Value, Nen)
                        Kyoiku = IIf(Right(Kyoiku, 1) = "、", Kyoiku, Kyoiku & "、") & Format(.Cells(10, i).Value, Nen)
                        年 = Year(.Cells(10, i).Value)
                    End If
                End If
            End If
        Next
        If Kyugyo <> "" Then
            Kyugyo = Left(Kyugyo, Len(Kyugyo) - 1)
            Cells(32, 4).Value = Kyugyo
            Cells(34, 4).Value = .Cells(7, 3).Value
            Cells(34, 14).Value = WorksheetFunction.CountIf(.Range("D7:AH7"), ">0")
        End If
        If Kyoiku <> "" Then
            Kyoiku = Left(Kyoiku, Len(Kyoiku) - 1)
            Cells(37, 4).Value = Kyoiku
            Cells(39, 3).Value = .Cells(8, 3).Value
            Cells(39, 14).Value = WorksheetFunction.CountIf(.Range("D8:AH8"), ">0")
        End If
    
    End With
    Application.ScreenUpdating = True
    MsgBox "OK", 64, aaa
End Sub
Sub 支給申請データ()
    Dim n As Integer
    Application.ScreenUpdating = False
    With Worksheets("結果")
        If MsgBox("「休業・教育訓練実施結果表」「様式5号」からデータ読込セットします。これらのデータが作成されていない場合は正しい値を返しません。よろしいですか？", 4 + 32, aaa) <> 6 Then Exit Sub
        Cells(34, 4).Value = .Cells(7, 35).Value
        Cells(34, 10).Value = .Cells(8, 36).Value
        Cells(36, 4).Value = Int(Cells(34, 4).Value * Worksheets("第105号の2").Cells(21, 10).Value)
        Cells(36, 10).Value = Int(Cells(34, 10).Value * (Worksheets("第105号の2").Cells(21, 10).Value + Worksheets("DATA1").Cells(21, 3).Value))
        Range("R34:W34,R36:W36").FormulaR1C1 = "=RC[-14]+RC[-8]"
    
    End With
    MsgBox "OK", 64, aaa
    Application.ScreenUpdating = True
End Sub
Sub 残業実績内訳書から()
If MsgBox("「時間」「判定基礎期間」データを読込みます。その他は直接入力してください。", 4 + 32, aaa) <> 6 Then Exit Sub
With Worksheets("残業実績内訳表")
Cells(9, 11).Value = .Cells(42, 12).Value
Cells(12, 11).Value = .Cells(42, 14).Value
Cells(25, 11).Value = .Cells(42, 16).Value
Cells(36, 11).Value = .Cells(42, 17).Value
Cells(39, 6).Value = Mid(.Cells(5, 13).Value, 1, 11)
Cells(39, 10).Value = Mid(.Cells(5, 13).Value, 15, 11)
End With
MsgBox "OK", 64, aaa
End Sub
Sub 印刷基本情報()
If MsgBox("プリンタの準備はいいですか？", 4 + 32, "印刷") <> 6 Then Exit Sub
ActiveSheet.PrintOut
End Sub
Sub 印刷個人情報()
If MsgBox("プリンタの準備はいいですか？", 4 + 32, "印刷") <> 6 Then Exit Sub
Range(Cells(6, 2), Cells(Cells(10000, 3).End(xlUp).Row, 7)).PrintOut
End Sub


Attribute VB_Name = "終了"
Attribute VB_Base = "0{6AE54356-47F3-4C4E-B7D8-1B30A68C50C1}{347DFF9A-05AA-4452-8562-A2AB1E2C500D}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
…