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
'
'
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'    ThisWorkbook.Saved = True
'End Sub
'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'   MsgBox "このファイルは保存することができません。", 16, "保存不可"
'   Cancel = True
'End Sub
'

Attribute VB_Name = "Sheet1"
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 = "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 = "設置届"
Attribute VB_Base = "0{9BD4DE12-EDA1-4E4D-813B-E0E020D7945F}{A26C938C-F068-496E-A036-38724F6D77D7}"
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 i           As Integer

Private Sub CommandButton1_Click()
        '会社情報データ取り込み
        If MsgBox("会社情報データを読み込みます。よろしいですか？", 1 + 32, "読込") <> 1 Then Exit Sub
        
        Call クリア
        With Worksheets("DATA")
            Text1.Value = StrConv(.Cells(109, 2).Value, vbNarrow) 'フリガナ
            Text14.Value = StrConv(.Cells(109, 2).Value, vbNarrow) 'フリガナ
            Text3.Value = .Cells(38, 2).Value '会社名（漢字）
            Text15.Value = .Cells(38, 2).Value
            Text5.Value = .Cells(39, 2).Value '郵便番号
            Text6.Value = .Cells(40, 2).Value '所在地
            Text13.Value = .Cells(40, 2).Value
            Text9.Value = .Cells(43, 2).Value '電話番号
            Text17.Value = .Cells(42, 2).Value '氏名
            Text18.Value = .Cells(45, 2).Value '業務の概要
            Text25.Value = .Cells(63, 2).Value '締
            Text26.Value = .Cells(64, 2).Value '締
            Text27.Value = .Cells(65, 2).Value '支払日
            
            If .Cells(30, 2).Value <> "" Then '社会保険加入状況
                Text30.Value = True
                Text31.Value = True
            End If
            If .Cells(131, 2).Value <> "" Then '労災保険加入状況
                Text32.Value = True
            End If
            
            
        End With
            
End Sub

'Private Sub UserForm_Initialize()
Private Sub UserForm_Activate()
        If ActiveSheet.Name = "設置届" Then
            lNo.Visible = True
        End If
'カレンダーコントロール関係
        Controls("Text10").ShowDropButtonWhen = fmShowDropButtonWhenAlways
        Controls("Text19").ShowDropButtonWhen = fmShowDropButtonWhenAlways
        Controls("Text20").ShowDropButtonWhen = fmShowDropButtonWhenAlways
        
        '労働者数
        For i = 1 To 999
            Text22.AddItem i
            Text23.AddItem i
            Text24.AddItem i
        Next
        '賃金支払い
        Text26.AddItem "当"
        Text26.AddItem "翌月"
        For i = 1 To 30
            Text27.AddItem i
        Next
        Text27.Text = "末"
        
        '労働保険番号
        With Worksheets("DATA")
            For i = 131 To 181 Step 10
                Text11.AddItem .Cells(i, 2).Value
            Next
        End With
        
        '保存データシートから読み込み
        Call シートから読込
        
End Sub
Private Sub Text10_DropButtonClick()
        Call カレ表示("10", "設置年月日")
End Sub
Private Sub Text19_DropButtonClick()
        Call カレ表示("19", "事業の開始年月日")
End Sub
Private Sub Text20_DropButtonClick()
        Call カレ表示("20", "事業の廃止年月日")
End Sub
Private Sub カレ表示(No As String, Title As String)
        'カレンダー設定
        Dim lngLeft As Long, lngTop As Long
        ' フォーム+テキストボックスのLeft,Top値から位置を判定
        lngLeft = Me.Left + Controls("Text" & No).Left + 20
        lngTop = Me.Top + Controls("Text" & No).Top - 100
        With カレンダー
            .Caption = Title
            .Label8.Caption = "Text" & No
            .Label9.Caption = Me.Name
                .Left = lngLeft
                .Top = lngTop
            ' カレンダーフォームを表示
            .Show
        End With
End Sub
Sub シートへ書き出す()
    With Worksheets("保存データ")
        For i = 1 To 37
            If i = 10 And i = 19 Then
                .Cells(i, 2).Value = Format(Controls("Text" & i).Value, "yyyy/mm/dd")
            Else
                .Cells(i, 2).Value = Controls("Text" & i).Value
            End If
        Next
    End With
    With Worksheets("印刷DATA")
        For i = 1 To 32
            If i = 19 Then
                Worksheets("設置届").Cells(.Cells(i + 15, 3).Value, .Cells(i + 15, 4).Value).Value = Worksheets("保存データ").Cells(i, 2).Value
            ElseIf i = 21 Then
                Worksheets("設置届").Cells(.Cells(i + 9, 3).Value, .Cells(i + 9, 4).Value).Value = Worksheets("保存データ").Cells(i, 2).Value
            ElseIf i >= 22 And i <= 26 Then
                Worksheets("設置届").Cells(.Cells(i + 1, 3).Value, .Cells(i + 1, 4).Value).Value = Worksheets("保存データ").Cells(i, 2).Value
            ElseIf i = 27 Then
                Worksheets("設置届").Cells(.Cells(i + 22, 3).Value, .Cells(i + 22, 4).Value).Value = Worksheets("保存データ").Cells(i, 2).Value
            ElseIf i >= 28 And i <= 29 Then
                Worksheets("設置届").Cells(.Cells(i, 3).Value, .Cells(i, 4).Value).Value = Worksheets("保存データ").Cells(i, 2).Value
            ElseIf i >= 30 And i <= 32 Then
                Worksheets("設置届").Cells(.Cells(i + 6, 3).Value, .Cells(i + 6, 4).Value).Value = Worksheets("保存データ").Cells(i, 2).Value
            ElseIf i = 20 Then
            '何もしない
            Else
                Worksheets("設置届").Cells(.Cells(i + 3, 3).Value, .Cells(i + 3, 4).Value).Value = Worksheets("保存データ").Cells(i, 2).Value
            End If

        Next
    
    End With
    
End Sub
Sub シートから読込()

     With Worksheets("保存データ")
        For i = 1 To 37
                         
            Select Case i
            Case 1, 2, 10, 11, 14, 16, 12
                If Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i + 3, 3).Value, Worksheets("印刷DATA").Cells(i + 3, 4).Value).Value = "" Then
                    Controls("Text" & i).Value = .Cells(i, 2).Value
                Else
                    Controls("Text" & i).Value = Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i + 3, 3).Value, Worksheets("印刷DATA").Cells(i + 3, 4).Value).Value
                End If
            Case 22, 23, 24
                If Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i + 1, 3).Value, Worksheets("印刷DATA").Cells(i + 1, 4).Value).Value = "" Then
                    Controls("Text" & i).Value = .Cells(i, 2).Value
                Else
                    Controls("Text" & i).Value = Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i + 1, 3).Value, Worksheets("印刷DATA").Cells(i + 1, 4).Value).Value
                End If
            Case 28, 29
                If Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i, 3).Value, Worksheets("印刷DATA").Cells(i, 4).Value).Value = "" Then
                    Controls("Text" & i).Value = .Cells(i, 2).Value
                Else
                    Controls("Text" & i).Value = Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i, 3).Value, Worksheets("印刷DATA").Cells(i, 4).Value).Value
                End If
            Case 30, 31, 32
                If Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i + 6, 3).Value, Worksheets("印刷DATA").Cells(i + 6, 4).Value).Value = "" Then
                    Controls("Text" & i).Value = .Cells(i, 2).Value
                Else
                    Controls("Text" & i).Value = Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i + 6, 3).Value, Worksheets("印刷DATA").Cells(i + 6, 4).Value).Value
                End If
            Case 21
                If Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i + 9, 3).Value, Worksheets("印刷DATA").Cells(i + 9, 4).Value).Value = "" Then
                    Controls("Text" & i).Value = .Cells(i, 2).Value
                Else
                    Controls("Text" & i).Value = Worksheets("設置届").Cells(Worksheets("印刷DATA").Cells(i + 9, 3).Value, Worksheets("印刷DATA").Cells(i + 9, 4).Value).Value
                End If

            Case Else
                Controls("Text" & i).Value = .Cells(i, 2).Value
            End Select
        Next
    End With
End Sub
Sub クリア()
     For i = 1 To 37
             Controls("Text" & i).Value = ""
        Next
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     Call シートへ書き出す
End Sub





Attribute VB_Name = "シート選択"
Option Explicit
Public Nusi As String
Public Const AAA As String = "労働保険　新規適用関係処理"
Sub 初期処理()
    Dim s As Worksheet
    Dim i               As Integer
    Dim j               As Integer
    Dim k               As Integer
    Dim Myfile          As String
    Dim DaFile          As String
    Dim MyStr           As String
    Dim TextFilename    As String
    Dim MyData(1)       As String
    
    For Each s In Worksheets
        With s
            .Activate
            ActiveWindow.DisplayHeadings = False
            .EnableSelection = xlUnlockedCells
            .Protect UserInterfaceOnly:=True
        End With
    Next
    
    Nusi = False '事業主はそのまま、trueになると予備を使う
    Myfile = Worksheets("DATA").Cells(1, 1).Value
    With Workbooks(Myfile).Worksheets("会社情報")
        Worksheets("DATA").Range("B34:B190").Value = .Range("B4:B160").Value2
        j = Val(.Cells(25, 2).Value) '料率パターン
        j = 71 + 11 * (j - 1) '料率パターンの行番号
        If j < 71 Then j = 71
        k = Val(.Cells(73, 2).Value) '端数処理パターン
        k = 292 + 4 * (k - 1)     '端数パターンの行番号
        If k < 292 Then k = 292
    End With
    
    Sheets("DATA").Select
    With Workbooks("DaMenu.xls").Worksheets("標準報酬月額")
    Range("I4:I13").Value = .Range("C" & j & ":C" & (j + 9)).Value '現在料率
    Range("I17").Value = .Range("C70").Value '児童手当
    Range("I18:I21").Value = .Range("C" & k & ":C" & (k + 3)).Value '端数処理
        i = 4
        TextFilename = ThisWorkbook.Path & "\MyTool\Todouhuken.dat" '都道府県
        Open TextFilename For Input As #1
            Do Until EOF(1)
                Input #1, MyData(1)
                Cells(i, 11).Value = MyData(1)
                i = i + 1
            Loop
        Close #1
        Dim MyData2(1) As String
            i = 24
            TextFilename = ThisWorkbook.Path & "\MyTool\ZimukumiaiJoho.dat" '組合
            Open TextFilename For Input As #1
                Do Until EOF(1)
                    Input #1, MyData2(1)
                    Cells(i, 9).Value = MyData2(1)
                    i = i + 1
                Loop
            Close #1
    End With
    Worksheets("MENU").Select
    
    
End Sub
Sub 設置届フォームへ()
    設置届.Show
End Sub
Sub 成立届フォームへ()
    成立届.Show
End Sub
Sub 設置届へ()
    Worksheets("設置届").Select
End Sub
Sub 設置届印刷シートへ()
    Dim n   As Integer
    Dim wb  As Object
    
    n = 0
    For Each wb In Workbooks
    If wb.Name = "雇用保険設置届印刷シート.xls" Then
        n = 1
        wb.Activate
    End If
    Next
    If n = 0 Then
        Workbooks.Open ThisWorkbook.Path & "\労働保険新規適用\雇用保険設置届印刷シート.xls"
         '20101028masa 2010問題　閉じるボタンを張り付ける
        Application.ScreenUpdating = False
        If Workbooks("雇用保険設置届印刷シート.xls").BuiltinDocumentProperties("Keywords").Value <> 2010 Then
        Workbooks.Open Workbooks("DaMenu.xls").Path & "\閉じるボタン.xls"
        Workbooks("閉じるボタン.xls").Worksheets("Button").Shapes("Zu10").Copy
        Workbooks("雇用保険設置届印刷シート.xls").Activate
        ActiveSheet.Unprotect
        Range("A1").Select
        DoEvents
        ActiveSheet.Paste
        ActiveSheet.Shapes("Zu10").Top = 18
        ActiveSheet.Shapes("Zu10").Left = 117
        Range("A1").Select
        Workbooks("雇用保険設置届印刷シート.xls").BuiltinDocumentProperties("Keywords").Value = 2010
        Application.EnableEvents = False
        ActiveWorkbook.Save
        Application.EnableEvents = True
        Workbooks("閉じるボタン.xls").Close False
    End If
    Application.ScreenUpdating = True
    End If
End Sub
Sub 設置届裏面印刷シートへ()
    Dim n   As Integer
    Dim wb  As Object
    
    n = 0
    For Each wb In Workbooks
    If wb.Name = "雇用保険設置届印刷シート裏.xls" Then
        n = 1
        wb.Activate
    End If
    Next
    If n = 0 Then
        Workbooks.Open ThisWorkbook.Path & "\労働保険新規適用\雇用保険設置届印刷シート裏.xls"
        '20101028masa 2010問題　閉じるボタンを張り付ける
        Application.ScreenUpdating = False
        If Workbooks("雇用保険設置届印刷シート裏.xls").BuiltinDocumentProperties("Keywords").Value <> 2010 Then
        Workbooks.Open Workbooks("DaMenu.xls").Path & "\閉じるボタン.xls"
        Workbooks("閉じるボタン.xls").Worksheets("Button").Shapes("Zu11").Copy
        Workbooks("雇用保険設置届印刷シート裏.xls").Activate
        ActiveSheet.Unprotect
        Range("A1").Select
        DoEvents
        ActiveSheet.Paste
        ActiveSheet.Shapes("Zu11").Top = 18
        ActiveSheet.Shapes("Zu11").Left = 138
        Range("A1").Select
        Workbooks("雇用保険設置届印刷シート裏.xls").BuiltinDocumentProperties("Keywords").Value = 2010
        Application.EnableEvents = False
        ActiveWorkbook.Save
        Application.EnableEvents = True
        Workbooks("閉じるボタン.xls").Close False
    End If
    Application.ScreenUpdating = True
    End If
End Sub
Sub 成立届印刷シートへ()
    Dim n   As Integer
    Dim wb  As Object
    
    n = 0
    For Each wb In Workbooks
    If wb.Name = "成立届届印刷シート.xls" Then
        n = 1
        wb.Activate
    End If
    Next
    If n = 0 Then
        Workbooks.Open ThisWorkbook.Path & "\労働保険新規適用\成立届印刷シート.xls"
        '20101028masa 2010問題　閉じるボタンを張り付ける
        Application.ScreenUpdating = False
        If Workbooks("成立届印刷シート.xls").BuiltinDocumentProperties("Keywords").Value <> 2010 Then
        Workbooks.Open Workbooks("DaMenu.xls").Path & "\閉じるボタン.xls"
        Workbooks("閉じるボタン.xls").Worksheets("Button").Shapes("Zu12").Copy
        Workbooks("成立届印刷シート.xls").Activate
        ActiveSheet.Unprotect
        Range("A1").Select
        DoEvents
        ActiveSheet.Paste
        ActiveSheet.Shapes("Zu12").Top = 13
        ActiveSheet.Shapes("Zu12").Left = 129
        Range("A1").Select
        Workbooks("成立届印刷シート.xls").BuiltinDocumentProperties("Keywords").Value = 2010
        Application.EnableEvents = False
        ActiveWorkbook.Save
        Application.EnableEvents = True
        Workbooks("閉じるボタン.xls").Close False
    End If
    Application.ScreenUpdating = True


    End If
End Sub
Sub 終了へ()
    If MsgBox("終了しますか？", 1 + 32, AAA) <> 1 Then Exit Sub
    Application.DisplayAlerts = (False)        'メッセージ非表示
    ThisWorkbook.Close
End Sub
Sub 会社Fへ()
    Application.Run "DaAddin.xla!会社Fへ"
End Sub
Sub 給与Fへ()
    Application.Run "DaAddin.xla!給与Fへ"
End Sub
Sub 個人Fへ()
    Application.Run "DaAddin.xla!個人Fへ"
End Sub
Sub 保存Fへ()
    保存F.Show
End Sub
Sub 保存読込へ()
    保存読込.Show
End Sub
Sub 変則的概算保険料へ()
    変則的概算保険料.Show
End Sub
Sub 申告書へ()
    Worksheets("申告書").Select
End Sub
'Sub 保存データ作成()
'    Da保存.Show 0
'End Sub
'Sub 保存データ読込()
'    Da保存読込.Show
'End Sub
Sub メニューへ()
    Worksheets("MENU").Select
End Sub

Attribute VB_Name = "Class1"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private WithEvents clsBTN As MSForms.CommandButton
Attribute clsBTN.VB_VarHelpID = -1

Public Property Set Object(setObject As MSForms.CommandButton)
    Set clsBTN = setObject
End Property

Public Property Get Object() As MSForms.CommandButton
    Set Object = clsBTN
End Property

Private Sub clsBTN_Click()   'インスタンスのClickイベント
    Dim Temp1 As Integer
    Dim Temp2 As Integer
    With カレンダー.SpinButton1
        Temp1 = (.Value - 1) \ 12 + 1
        Temp2 = (.Value - 1) Mod 12 + 1
    End With
    If カレンダー.Label9.Caption = "設置届" Then
'        設置届.Controls(カレンダー.Label8.Caption).Value = Format(DateValue(Temp1 & "/" & Temp2 & "/" + clsBTN.Caption), "gemmdd")
        設置届.Controls(カレンダー.Label8.Caption).Value = Format(DateValue(Temp1 & "/" & Temp2 & "/" + clsBTN.Caption), "gemmdd")
    
    End If
    If カレンダー.Label9.Caption = "成立届" Then
        If カレンダー.Label8.Caption = "Text60" Or カレンダー.Label8.Caption = "Text61" Then
            成立届.Controls(カレンダー.Label8.Caption).Value = Format(DateValue(Temp1 & "/" & Temp2 & "/" + clsBTN.Caption), "7-e-mm-dd")
        Else
            成立届.Controls(カレンダー.Label8.Caption).Value = Format(DateValue(Temp1 & "/" & Temp2 & "/" + clsBTN.Caption), "gemmdd")
        End If
    End If
    
    
    
   
    
    Unload カレンダー
End Sub




Attribute VB_Name = "カレンダー"
Attribute VB_Base = "0{E4341AA5-D01C-4944-BD43-80ABB4B03FB8}{BDA2E55F-2A8C-4984-A00E-1421FF52C0D8}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False







Dim clsCmd() As Class1   'クラスオブジェクトを格納する動的配列
Private Sub 日付表示(MyDay As Integer)
'20080605　kon
'設置届.Controls(カレンダー.Label8.Caption).Value = Format(Date + MyDay, "gemmdd")

    If Label9.Caption = "設置届" Then
        設置届.Controls(Label8.Caption).Value = Format(Date + MyDay, "gemmdd")
    ElseIf Label9.Caption = "成立届" Then
        If Label8.Caption = "Text60" Or Label8.Caption = "Text61" Then
            成立届.Controls(Label8.Caption).Value = "7-" & Format(Date + MyDay, "e-mm-dd")
        Else
            成立届.Controls(Label8.Caption).Value = Format(Date + MyDay, "gemmdd")
        End If
    End If

Unload Me
End Sub

Private Sub ComboBox1_Change()
    SpinButton1.Value = (ComboBox1.ListIndex + 1926 - 1) * 12 + Val(ComboBox2.Value)
End Sub

Private Sub ComboBox2_Change()
    SpinButton1.Value = (ComboBox1.ListIndex + 1926 - 1) * 12 + Val(ComboBox2.Value)
End Sub

Private Sub CommandButton38_Click()
Call 日付表示(-1)
End Sub

Private Sub CommandButton39_Click()
Call 日付表示(0)
End Sub
Private Sub CommandButton40_Click()
Call 日付表示(1)
End Sub
Private Sub CommandButton42_Click()
Dim Myd As Date
'20080605 kon
'Myd = DateSerial(ComboBox1.ListIndex + 1926, ComboBox2.Value, ComboBox3.Value)
'選択.TextBox6.Value = Format(Myd, "GGGE年M月D日")
    
    Myd = DateSerial(ComboBox1.ListIndex + 1926, ComboBox2.Value, ComboBox3.Value)
    If Label9.Caption = "成立届" Then
        If Label8.Caption = "Text60" Or Label8.Caption = "Text61" Then
            成立届.Controls(Label8.Caption).Value = Format(Myd, "7-e-mm-dd")
        Else
            成立届.Controls(Label8.Caption).Value = Format(Myd, "gemmdd")
        End If
    ElseIf Label9.Caption = "設置届" Then
        設置届.Controls(Label8.Caption).Value = Format(Myd, "gemmdd")
    End If

Unload Me
End Sub

Private Sub UserForm_Activate()
    ReDim clsCmd(1 To 37)   '動的配列の再定義
    For i = 1 To 37
        Set clsCmd(i) = New Class1
        Set clsCmd(i).Object = Me.Controls("CommandButton" & CStr(i))
    Next i
    SpinButton1.Min = 1899 * 12 + 1                           '1900年の1月の総月数
    SpinButton1.Max = 2100 * 12                               '2100年の12月の総月数
    For i = 1 To 63
        ComboBox1.AddItem "昭和" & i
    Next
    For i = 1 To 30
        ComboBox1.AddItem "平成" & i
    Next
    For i = 1 To 12
        ComboBox2.AddItem i
    Next
    For i = 1 To 31
        ComboBox3.AddItem i
    Next
    ComboBox1.ListIndex = Year(Date) - 1926
    ComboBox2.Value = Month(Date)
    ComboBox3.Value = Day(Date)
    SpinButton1.Value = (Year(Date) - 1) * 12 + Month(Date)   '今日の月の総月数
    Display_Calendar

End Sub
Private Sub SpinButton1_Change()
    Display_Calendar   'サブルーチン
End Sub
Sub Display_Calendar()
Dim iBlank_Days As Integer    '1日以前の曜日の空白日数（日曜日始まり）
Dim iExtend_Days As Integer   '空白日数を含めた月末の日までの日数

    With SpinButton1
        Temp1 = CStr((.Value - 1) \ 12) + 1     '総月数から求めた年数
        Temp2 = CStr((.Value - 1) Mod 12 + 1)   '総月数から求めた月数
        'DisplayMonth.Caption = Temp1 & "年" + Temp2 & "月"
        temp = Temp1 & "/" & Temp2 & "/1"
        DisplayMonth.Caption = Format(temp, "ggge年m月")
        iBlank_Days = Weekday(temp) - 1
        iExtend_Days = Num_of_Days() + iBlank_Days   'FunctionプロシージャNum_of_Days
    End With
        
    For i = 1 To iBlank_Days   '月初の空白を設定
        clsCmd(i).Object.Visible = False
    Next i
    
    For i = iBlank_Days + 1 To iExtend_Days   '1～末日の日を設定
        clsCmd(i).Object.Visible = True
        clsCmd(i).Object.Caption = CStr(i - iBlank_Days)
    Next i

    For i = iExtend_Days + 1 To 37   '月末の空白を設定
        clsCmd(i).Object.Visible = False
    Next i
End Sub

Function Num_of_Days() As Integer
    With SpinButton1
        iTemp = (.Value - 1) Mod 12 + 1
        Select Case iTemp
        Case 1, 3, 5, 7, 8, 10, 12
            Num_of_Days = 31   '戻り値を設定
        Case 4, 6, 9, 11
            Num_of_Days = 30   '戻り値を設定
        Case 2   '2月の日数を計算
            iTemp = (.Value - 1) \ 12 + 1
            Start_Date = CStr(iTemp) & "/2/1"
            End_Date = CStr(iTemp) & "/3/1"
            Num_of_Days = DateDiff("d", Start_Date, End_Date)   '戻り値を設定
        End Select
    End With
End Function


Attribute VB_Name = "成立届"
Attribute VB_Base = "0{A3418C52-2431-4220-A6B1-4DA72F989BCF}{D9A97E02-C0B8-417C-9D1E-C633B583B4E6}"
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 i       As Integer
Dim n       As Integer
Dim nn      As Integer
Dim nnn     As Integer

'Private Sub UserForm_Initialize()
Private Sub UserForm_Activate()
'カレンダーコントロール関係
        Controls("Text37").ShowDropButtonWhen = fmShowDropButtonWhenAlways
        Controls("Text38").ShowDropButtonWhen = fmShowDropButtonWhenAlways
        Controls("Text50").ShowDropButtonWhen = fmShowDropButtonWhenAlways
        Controls("Text51").ShowDropButtonWhen = fmShowDropButtonWhenAlways
        Controls("Text60").ShowDropButtonWhen = fmShowDropButtonWhenAlways
        Controls("Text61").ShowDropButtonWhen = fmShowDropButtonWhenAlways
        '種別
        Text1.AddItem "0"
        Text1.List(0, 1) = "0 成立届（継続）"
        Text1.AddItem "1"
        Text1.List(1, 1) = "1 成立届（有期）"
        Text1.AddItem "2"
        Text1.List(2, 1) = "2 任意加入申請書"
       
        
        '保存データシートから読み込み
        Call シートから読込
End Sub
Private Sub Text37_DropButtonClick()
        Call カレ表示("37", "労災成立年月日")
End Sub
Private Sub Text38_DropButtonClick()
        Call カレ表示("38", "雇用保険設立年月日")
End Sub
Private Sub Text50_DropButtonClick()
        Call カレ表示("50", "事業の開始年月日")
End Sub
Private Sub Text51_DropButtonClick()
        Call カレ表示("51", "事業の廃止年月日")
End Sub
Private Sub Text60_DropButtonClick()
        Call カレ表示("60", "保険関係成立年月日")
End Sub
Private Sub Text61_DropButtonClick()
        Call カレ表示("61", "事務処理委託年月日")
End Sub
Private Sub カレ表示(No As String, Title As String)
        'カレンダー設定
        Dim lngLeft As Long, lngTop As Long
        ' フォーム+テキストボックスのLeft,Top値から位置を判定
        lngLeft = Me.Left + Controls("Text" & No).Left + 20
        lngTop = Me.Top + Controls("Text" & No).Top - 100
        With カレンダー
            .Caption = Title
            .Label8.Caption = "Text" & No
            .Label9.Caption = Me.Name
                .Left = lngLeft
                .Top = lngTop
            ' カレンダーフォームを表示
            .Show
        End With
End Sub
Sub シートへ書き出す()
    With Worksheets("保存データ")
        For i = 1 To 75
            .Cells(i + 49, 2).Value = Controls("Text" & i).Value
        Next
    End With
End Sub
Sub シートから読込()
     With Worksheets("保存データ")
        For i = 1 To 75
             Controls("Text" & i).Value = .Cells(i + 49, 2).Value
        Next
    End With
End Sub
Sub クリア()
     For i = 1 To 75
             Controls("Text" & i).Value = ""
        Next
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     Call シートへ書き出す
End Sub
Private Sub TEL(Denwa As String, n, nn, nnn)
            Dim j As Integer
            Dim k As Integer
            Dim l As Integer
            j = 0
            k = 0
            With Worksheets("DATA")
                For l = 1 To Len(Denwa)
                    If Mid(Denwa, l, 1) = "-" Then
                        If j = 0 Then
                            j = l
                            Else
                            k = l
                        End If
                    End If
                Next
                If j = 0 Then 'ＴＥＬ１
                    Controls("Text" & n).Value = Denwa
                    Exit Sub
                    Else
                    Controls("Text" & n).Value = Mid(Denwa, 1, j - 1)
                End If
                If k = 0 Then 'ＴＥＬ2
                    Controls("Text" & nn).Value = Mid(Denwa, j + 1, Len(Denwa) - j)
                    Exit Sub
                    Else
                    Controls("Text" & nn).Value = Mid(Denwa, j + 1, k - j - 1)
                End If
                Controls("Text" & nnn).Value = Mid(Denwa, k + 1, Len(Denwa) - k) 'ＴＥＬ3
            End With
End Sub
Private Sub CommandButton7_Click()
'名称氏名フリガナ入力
        成立届入力.Caption = "⑲名称氏名<カナ>を入力して下さい"
        成立届入力.Label1.Caption = 16
        成立届入力.Show
End Sub
Private Sub CommandButton1_Click()
'住所カナフリガナ入力
        成立届入力.Caption = "⑰住所<カナ>を入力して下さい"
        成立届入力.Label1.Caption = 8
        成立届入力.Show
End Sub
Private Sub OptionButton1_Click()
'事務組合データを表示
        With Worksheets("DATA")
            Text42.Value = .Cells(24, 9).Value
            Text43.Value = .Cells(25, 9).Value
            Call TEL(.Cells(29, 9), 44, 45, 46)
            Text47.Value = .Cells(26, 9).Value
            Text48.Value = .Cells(27, 9).Value & .Cells(28, 9).Value
        End With
End Sub
Private Sub OptionButton2_Click()
'事務組合データを非表示
        For i = 0 To 6
            Controls("Text" & 42 + i).Value = ""
        Next
End Sub
Private Sub CommandButton5_Click()
'会社情報データ取り込み
        If MsgBox("会社情報データを読み込みます。よろしいですか？", 1 + 32, "読込") <> 1 Then Exit Sub
        
        Call クリア
         With Worksheets("DATA")
            Text2.Value = .Cells(68, 2).Value '局長
            Text6.Value = Mid(.Cells(39, 2).Value, 1, 3) '郵便番号
            Text7.Value = Mid(.Cells(39, 2).Value, 5, 4)
            Text27.Value = .Cells(39, 2).Value '郵便番号
            
'20091021masa
            Text12.Value = .Cells(40, 2).Value '事業主住所
            Text25.Value = .Cells(40, 2).Value '事業主住所
            Text28.Value = .Cells(40, 2).Value '事業主住所
'20091021masa
            Text22.Value = .Cells(38, 2).Value '名称
            Text26.Value = .Cells(38, 2).Value '名称
            Text32.Value = .Cells(38, 2).Value '名称
            
            Call TEL(.Cells(43, 2), 19, 20, 21)
            Call TEL(.Cells(43, 2), 29, 30, 31)
            
             Text33.Value = .Cells(45, 2).Value '事業概要
            
        End With
End Sub



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

Attribute VB_Name = "成立届入力"
Attribute VB_Base = "0{ADA358D3-4183-4467-889D-6706C968033C}{DEEE7FCE-3FE3-464F-924D-110063FC4EBF}"
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 i As Integer
Dim n As Integer

Private Sub CommandButton1_Click()
    n = 0
    If Label1.Caption = 8 Then
        For i = 0 To 3
            If i = 0 Then
                成立届.Controls("Text" & Label1.Caption + i).Value = Mid(TextBox1.Value, 1, 10)
            Else
                成立届.Controls("Text" & Label1.Caption + i).Value = Mid(TextBox1.Value, 11 + n, 20)
                n = n + 20
            End If
        Next
    Else
        For i = 0 To 2
            成立届.Controls("Text" & Label1.Caption + i).Value = Mid(TextBox1.Value, 11 + n, 20)
        Next
    End If
    
        
    Unload Me
End Sub


Attribute VB_Name = "保存F"
Attribute VB_Base = "0{0CBACC1B-EFEF-483C-BE3A-8D9C3E4B2234}{FD028D7B-2F7A-4B50-BD63-D1C024A7FFFA}"
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 msg As Integer
Dim SS As Worksheet, ファイル名 As String
Private Sub CommandButton1_Click()
    Dim Check As Boolean
    Dim Myfile As String
    Dim Mysheet As String
    Dim 保存ファイル名 As String
    Check = False '上書きのチェック
    'シートをコピーして作成する、そのためリンクがかかるが、問題ないでしょう
    Application.DisplayAlerts = (False)
    With ThisWorkbook.Worksheets("DATA")
        If TextBox1.Value = "" Then
            MsgBox "ファイル名が入力されていません。", 16, AAA
            Exit Sub
        End If
        
        msg = MsgBox("よろしいですか？", 1 + 32, AAA)
        If msg = 1 Then
            If Dir(ActiveWorkbook.Path & "\労働保険新規適用\Da保存", 16) = "" Then MkDir ActiveWorkbook.Path & "\労働保険新規適用\Da保存" '保存台帳フォルダがなかったら作成する
                Myfile = ActiveWorkbook.Name
                Mysheet = ActiveSheet.Name
                If Mysheet = "設置届" Then
                    保存ファイル名 = TextBox1.Value & " " & Mysheet & " " & Left(.Cells(1, 1).Value, Len(.Cells(1, 1).Value) - 4) & ".xls"
                Else
                    '例えば、ファイル名が○○○でセルズda.xlsから読込んだ労災○○.xlsで保存したら　「○○○　労災○号　セルズda」となる
                    保存ファイル名 = TextBox1.Value & " " & Left(Myfile, Len(Myfile) - 4) & " " & Left(.Cells(1, 1).Value, Len(.Cells(1, 1).Value) - 4) & ".xls"
                End If
            Dim フルパス As String
            フルパス = ActiveWorkbook.Path & "\労働保険新規適用\Da保存\" & 保存ファイル名
            If 保存ファイル名 = Dir(フルパス) Then 'すでにあるかチェック
                If MsgBox("この保存ファイルはすでに存在します。上書きしますか？", 1 + 48, AAA) <> 1 Then
                    MsgBox "処理を中止します。", 64, AAA
                    Exit Sub
                Else
                    Kill ActiveWorkbook.Path & "\労働保険新規適用\Da保存\" & Left(保存ファイル名, Len(保存ファイル名) - 6) & ".png"
                End If
                
                ThisWorkbook.Worksheets("保存データ").Cells(125, 2).Value = ThisWorkbook.Worksheets("設置届").Cells(9, 10).Value
                ThisWorkbook.Worksheets("保存データ").Cells(126, 2).Value = ThisWorkbook.Worksheets("設置届").Cells(84, 3).Value
                ThisWorkbook.Worksheets("保存データ").Cells(99, 2).Value = ThisWorkbook.Worksheets("設置届").Cells(99, 4).Value
                ThisWorkbook.Worksheets("保存データ").Cells(100, 2).Value = ThisWorkbook.Worksheets("設置届").Cells(103, 4).Value
                
                
                ThisWorkbook.Worksheets("保存データ").Cells(30, 2).Value = ThisWorkbook.Worksheets("設置届").Cells(49, 11).Value
                ThisWorkbook.Worksheets("保存データ").Cells(31, 2).Value = ThisWorkbook.Worksheets("設置届").Cells(50, 11).Value
                ThisWorkbook.Worksheets("保存データ").Cells(32, 2).Value = ThisWorkbook.Worksheets("設置届").Cells(51, 11).Value
                
                
                Check = True
            End If
        
            Application.ScreenUpdating = False
            Label2.Visible = True
            Me.Repaint
            '新規ブックにシートをそのままコピーしてオブジェクト（マクロボタン）をクリアする
            '20070803
            Workbooks.Open ThisWorkbook.Path & "\Dummy.xls"
'            Range("C3:C350").Value = .Range("C3:C350").Value2
            ThisWorkbook.Worksheets("保存データ").Range("A1:Z200").Copy
            Range("A1").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            
            ActiveSheet.Name = "DATA"
            ActiveWorkbook.SaveAs FileName:=フルパス
            ActiveWorkbook.Close
            
            
            If Mysheet = "設置届" Then
                Call CopyAsPicture_table(ActiveWorkbook.Path & "\労働保険新規適用\Da保存\" & Left(保存ファイル名, Len(保存ファイル名) - 6), ActiveWorkbook.Path & "\労働保険新規適用\Da保存")
            End If
            
            ThisWorkbook.Activate
            
            
            Sheets(Mysheet).Select
            
            MsgBox "保存しました。" & Chr(13) & Chr(13) & _
            "このファイルは「保存データ」の読込ボタンから読み込むことができます。", 64, AAA
            Unload Me
            
        End If
    End With
    Application.ScreenUpdating = True

End Sub
Private Sub UserForm_Initialize()
    TextBox1.Value = "作成年月日 " & Format(Date, "gemmdd")
    
End Sub


Attribute VB_Name = "保存読込"
Attribute VB_Base = "0{EBAF37A9-69F6-48DE-A576-E0ED1F7DA6E4}{0A656D17-6615-4670-BE64-32E5A80DF6B6}"
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
…