Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 4c01e36178dc1030…

MALICIOUS

Office (OLE)

854.5 KB Created: 2010-08-09 02:36:11 Authoring application: Microsoft Excel First seen: 2018-06-21
MD5: f0b3d54825e40007217b413a9326a74d SHA-1: 91ef18c2ef3a3c6f062e916e59bb5b3d107acfc6 SHA-256: 4c01e36178dc10308ee85a302cdf194d4b6cae1b0b0c4ffbf5dc5b4c74f9efda
430 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1204.002 Malicious File T1059 Command and Scripting Interpreter T1105 Ingress Tool Transfer

The file contains VBA macros that leverage WScript.Shell and URLDownloadToFile to download and execute a payload from the provided URLs. The Auto_Open macro is triggered upon opening, indicating an attempt to immediately execute the malicious content. The document body, while appearing to be a legitimate Japanese leave request form, is likely a lure to trick users into opening the malicious macro-enabled Excel file.

Heuristics 11

  • Reference to URLDownloadToFile API critical SC_STR_URLDOWNLOAD
    Reference to URLDownloadToFile API
  • VBA macros detected medium 6 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
        Dim sc As Object
    Dim shell As Object
    Set shell = CreateObject("WScript.Shell")
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
        Dim shell As Object
    Set shell = CreateObject("WScript.Shell")
  • URLDownloadToFile in VBA critical OLE_VBA_DOWNLOAD
    URLDownloadToFile in VBA
    Matched line in script
    '----ダウンロード用 20100310 kon
Declare Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    End Sub
Sub Auto_Open()
    Dim n As Integer
  • Reference to ShellExecute API high SC_STR_SHELLEXEC
    Reference to ShellExecute API
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://www.team-cells.jp/dl/crossloopsetup.exe� Referenced by macro
    • http://www.team-cells.jp/php01/fileupload.htmlReferenced by macro
    • http://www.team-cells.jp/dl/daityo/Referenced by macro
    • http://www.team-cells.jp/dl/crossloopsetup.exeReferenced by macro

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 200422 bytes
SHA-256: 832cf732f20534d1bdbf74e049c88e6ba25a85757fa22086d151f11bd76a1912
Preview script
First 1,000 lines of the extracted script
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 = "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_Control = "CommandButton1, 46, 0, MSForms, CommandButton"
Option Explicit

Private Sub CommandButton1_Click()
    終了
End Sub

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 = "Sheet6"
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
    If Cells(100, 1).Value = 1 Then
    MsgBox "メニューの終了ボタンから終了してください", 16, "終了"
    Cancel = True '閉じる禁止　20101002重
    End If
    
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    MsgBox "このファイルは保存できません。", 16, "保存"
    Cancel = True
End Sub



Attribute VB_Name = "OK"
Attribute VB_Base = "0{4216D832-F005-4DCB-A804-0BB1ED5066DD}{FA18D4A7-7A57-45ED-8D8D-DDB660492D86}"
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()
    If Application.Wait(Now + TimeValue("0:00:1")) Then
        Unload Me
    End If
End Sub

Attribute VB_Name = "日数表"
Attribute VB_Base = "0{015C78EC-5F93-4E1A-85CD-83DE95B8291D}{DEA716A6-A851-48C4-925F-67669C4794BD}"
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()
    If Workbooks("yData.xls").Worksheets("DATA1").Cells(6, 6).Value <> "" Then 'すでに社員情報にデータがあったら
        If MsgBox("社員情報にデータが存在します。この変更は現在の社員情報すべてのデータが変更されます。よろしいですか？", 4 + 48, "処理年の変更") <> 6 Then Exit Sub
        Call 登録
        Call 数式代入(6)
    Else
        Call 登録
    End If
    MsgBox "登録しました。", 64, "登録"
    Unload Me
End Sub
Private Sub UserForm_Activate()
    Dim i As Integer
    Dim j As Integer
    Dim n As Integer
    With Workbooks("yData.xls").Worksheets("MASTER")
        n = 1
        For i = 16 To 21
            For j = 7 To 14
                Controls("TextBox" & n).Value = .Cells(j, i).Value
                n = n + 1
            Next j
        Next i
    End With
End Sub
Private Sub 登録()
    Dim i As Integer
    Dim j As Integer
    Dim n As Integer
    With Workbooks("yData.xls").Worksheets("MASTER")
        n = 1
        For i = 16 To 21
            For j = 7 To 14
                .Cells(j, i).Value = Controls("TextBox" & n).Value
                n = n + 1
            Next j
        Next i
    End With
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
    新規.TextBox3.Value = Format(DateValue(Temp1 & "/" & Temp2 & "/" + clsBTN.Caption), "GE/M/D")
    MyDate = DateValue(Temp1 & "/" & Temp2 & "/" + clsBTN.Caption)
    Unload カレンダー
End Sub

Attribute VB_Name = "カレンダー"
Attribute VB_Base = "0{47916CE0-1337-4571-947F-2963723ACA98}{A7B58ABA-9899-43B4-8226-481B20CDCC76}"
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)
新規.TextBox3.Value = Format(Date + MyDay, "ge/m/d")
MyDate = Date + MyDay
Unload Me
End Sub
Private Sub ComboBox1_Change()
    SpinButton1.Value = (ComboBox1.ListIndex + 1912 - 1) * 12 + Val(ComboBox2.Value)
'Display_Calendar
End Sub

Private Sub ComboBox2_Change()
    SpinButton1.Value = (ComboBox1.ListIndex + 1912 - 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
    MyD = DateSerial(ComboBox1.ListIndex + 1912, ComboBox2.Value, ComboBox3.Value)

        新規.TextBox3.Value = Format(MyD, "ge/m/d")
    MyDate = MyD
    Unload Me
End Sub

Private Sub CommandButton43_Click()
    ComboBox1.ListIndex = Year(Date) - 1912
    ComboBox2.Value = Month(Date)

End Sub

Private Sub UserForm_Activate()
    Application.ScreenUpdating = False
    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 15
        ComboBox1.AddItem "大正" & i
        ComboBox1.List(i - 1, 1) = i + 1911
    Next
    
    For i = 2 To 63
        ComboBox1.AddItem "昭和" & i
        ComboBox1.List(i + 13, 1) = i + 1925
    Next
    For i = 1 To Year(Date) - 1986
        ComboBox1.AddItem "平成" & i
        ComboBox1.List(i + 76, 1) = i + 1988
    Next
    For i = 1 To 12
        ComboBox2.AddItem i
    Next
    For i = 1 To 31
        ComboBox3.AddItem i
    Next
    '20070621 KON
'    ComboBox1.ListIndex = Year(mydate) - 1926
'    MsgBox ComboBox1.List(ComboBox1.ListCount - 1, 0)
    ComboBox1.ListIndex = Year(Date) - 1912
    ComboBox2.Value = Month(Date)
    ComboBox3.Value = Day(Date)
    SpinButton1.Value = (Year(Date) - 1) * 12 + Month(Date)   '今日の月の総月数
    Display_Calendar
    Application.ScreenUpdating = True
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(yyyy)年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{DCDFADED-1EF7-49B3-BF6B-615F4A9B30CD}{5EBB86B6-4705-4823-8B8C-CF7A8C0F8C71}"
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 Ro As Integer
Dim CO As Integer
Private Sub CommandButton1_Click()
    If ListBox3.ListIndex = -1 Then
    MsgBox "リストを選択してください。", 16, "リスト選択"
    Exit Sub
    End If
    With Workbooks("yData.xls").Worksheets("DATA1")
'20101111 kon
'        .Cells(Ro, CO + 31).Value = TextBox2.Value '日数
'        .Cells(Ro, CO + 44).Value = TextBox3.Value '時間
'        .Cells(Ro, CO + 60).Value = TextBox4.Value  '備考
        .Range(.Cells(Ro, 15), .Cells(Ro, 29)).FormulaR1C1 = .Range(.Cells(1, 15), .Cells(1, 29)).Value '数式を代入
        .Cells(Ro, 13).FormulaR1C1 = .Cells(1, 13).Value
        .Range(.Cells(Ro, 13), .Cells(Ro, 29)).Value = .Range(.Cells(Ro, 13), .Cells(Ro, 29)).Value
        TextBox6.Value = .Cells(Ro, CO + 29).Value      '変更された現在残数を表示する
'        ListBox4.List(CO, 1) = TextBox2.Value
'        ListBox4.List(CO, 2) = TextBox3.Value
        If Val(TextBox6.Value) < 0 Then
            MsgBox "残日数がマイナスとなっています。", 48, "残日数"
            Else
            OK.Show
        End If
    End With
End Sub

Private Sub CommandButton11_Click()
    If ListBox1.ListCount = 0 Then
        MsgBox "社員データが存在しません。", 16, "社員情報"
        Exit Sub
    End If

    帳票出力.Show
End Sub


Private Sub CommandButton2_Click()
    If ListBox1.ListCount = 0 Then Exit Sub
    If CommandButton2.Caption = "全表示" Then
        Call 全表示
        Else
        検索.Show
    End If
End Sub

Private Sub 全表示()
    Dim i As Integer
    Dim n As Integer
    ListBox3.Clear
    n = 0
    With ListBox1
        For i = 0 To .ListCount - 1
            Call リスト(i, n)
            n = n + 1
        Next
    End With
    CommandButton2.Caption = "検索"
    ListBox3.ListIndex = 0
End Sub

Private Sub CommandButton4_Click()
    新規.Show
End Sub

Private Sub CommandButton5_Click()
'    Application.ScreenUpdating = False
    Sheets("新規シート入力").Activate
    ActiveWindow.ScrollRow = 1
    Unload Me
'    Application.ScreenUpdating = True
End Sub

Private Sub CommandButton6_Click()
    If ListBox1.ListCount > 0 Then
        削除.Show
        Else
        MsgBox "社員データが存在しません。", 16, "エラー"
    End If
   
End Sub

Private Sub CommandButton7_Click()
    With Workbooks("yData.xls").Worksheets("DATA1")
        If Trim(.Cells(7, 6).Value) = "" Then
            MsgBox "データが2つ以上ないためこの処理を実行できません。", 16, "エラー"
            Exit Sub
        End If
        並び替え.Show
    End With
End Sub

Private Sub ListBox1_Click()
    Dim i As Integer
    Dim yDataMaster As Worksheet
    Set yDataMaster = Workbooks("yData.xls").Worksheets("MASTER")
    With Workbooks("yData.xls").Worksheets("DATA1")
        Ro = ListBox1.ListIndex + 6 '社員情報の行番号
        For i = 2 To 21 '項目を表示
            If InStr(.Cells(Ro, i).Value, ".") > 0 Then
                ListBox4.List(i - 2, 1) = Format(.Cells(Ro, i).Value, "0.00") '小数があれば2ケタ表示する
                Else
                ListBox4.List(i - 2, 1) = IIf(.Cells(Ro, i).Value = "", 0, .Cells(Ro, i).Value)
            End If
        Next
        ListBox4.List(0, 1) = .Cells(Ro, 2).Text
        ListBox4.List(20, 1) = .Cells(Ro, 28).Text '時間単位の限度時間
        ListBox4.List(13, 0) = "○前年" & ListBox4.List(10, 1) & "月～12月使用日数"
        ListBox4.List(14, 0) = IIf(Val(ListBox4.List(10, 1)) = 1, "   *********", "　本年1月～" & Val(ListBox4.List(10, 1)) - 1 & "月の使用日数")
        ListBox4.List(15, 0) = "　本年" & Val(ListBox4.List(10, 1)) & "月～12月の使用日数"
        If .Cells(Ro, 21).Text = "" Then ListBox4.List(19, 1) = yDataMaster.Cells(7, 9).Value '１日所定労働時間
        TextBox7.ControlSource = .Cells(Ro, 82).Address(, , , True) 'メモ
        
        If .Cells(Ro, 12).Value <= .Cells(1, 3) Then  '更新前だったら
            ListBox4.List(21, 0) = "　本年" & Val(ListBox4.List(10, 1)) & "月～12月の使用時間"
            ListBox4.List(21, 1) = .Cells(Ro, 31).Value '本年取得月以降の使用時間数
        Else
            ListBox4.List(21, 0) = IIf(Val(ListBox4.List(10, 1)) = 1, "　前年12月までの使用時間", "　本年" & Val(ListBox4.List(10, 1)) - 1 & "月までの使用時間")
            ListBox4.List(21, 1) = .Cells(Ro, 29).Value + .Cells(Ro, 30).Value '前年+本年の取得月の前月まで
        End If
        
        If .Cells(Ro, 3).Value = 0 Then '部門があったらNoから部門名を表示
            ListBox4.List(1, 1) = ""
            Else
            ListBox4.List(1, 1) = yDataMaster.Cells(4 + .Cells(Ro, 3).Value, 5).Value
            If ListBox4.List(1, 1) = "" Then ListBox4.List(1, 1) = "No" & .Cells(Ro, 3).Value & "は未登録"
        End If
        If .Cells(Ro, 4).Value = 0 Then '部課があったらNoから部課名を表示
            ListBox4.List(2, 1) = ""
            Else
            ListBox4.List(2, 1) = yDataMaster.Cells(4 + .Cells(Ro, 4).Value, 6).Value
            'YBNO 26909  ito 20150114　氏名ではなく部課に表示
            'If ListBox4.List(2, 1) = "" Then ListBox4.List(4, 1) = "No" & .Cells(Ro, 4).Value & "は未登録"
            If ListBox4.List(2, 1) = "" Then ListBox4.List(2, 1) = "No" & .Cells(Ro, 4).Value & "は未登録"
        End If
        ListBox4.List(3, 1) = IIf(.Cells(Ro, 5).Value = 0, "一般", "区分" & 5 - .Cells(Ro, 5).Value) '区分表示
        '表示のみの処理
        For i = 0 To 4
            ListBox4.List(i, 2) = ListBox4.List(i, 1)
        Next
        ListBox4.List(5, 2) = Format(ListBox4.List(5, 1), "gggee年mm月dd日")
        ListBox4.List(6, 2) = Format(ListBox4.List(6, 1), "gggee年mm月dd日")
        ListBox4.List(7, 2) = Int(Val(ListBox4.List(7, 1))) & "年" & Int((Val(ListBox4.List(7, 1)) - Int(Val(ListBox4.List(7, 1)))) * 12 + 0.9) & "ヶ月"
        ListBox4.List(8, 2) = ListBox4.List(8, 1) & "日"
        ListBox4.List(9, 2) = ListBox4.List(9, 1) & "日"
        ListBox4.List(10, 2) = ListBox4.List(10, 1) & "月"
        For i = 11 To 15
            ListBox4.List(i, 2) = Int(Val(ListBox4.List(i, 1))) & "日" & Int((Val(ListBox4.List(i, 1)) - Int(Val(ListBox4.List(i, 1)))) * Val(ListBox4.List(19, 1)) + 0.1) & "時間"
        Next
        ListBox4.List(16, 2) = ListBox4.List(16, 1) & "日"
        ListBox4.List(17, 2) = Int(Val(ListBox4.List(17, 1))) & "日" & Int((Val(ListBox4.List(17, 1)) - Int(Val(ListBox4.List(17, 1)))) * Val(ListBox4.List(19, 1)) + 0.1) & "時間"
        For i = 18 To 21
            ListBox4.List(i, 2) = ListBox4.List(i, 1) & "時間"
        Next
        CreateListbox5 '#25073
        ListBox5.List(0, 2) = ListBox4.List(12, 2)
        For i = 0 To 11
            If .Cells(Ro, i * 4 + 35).Value <> 0 Or .Cells(Ro, i * 4 + 36).Value <> 0 Then
                ListBox5.List(i + 1, 2) = IIf(.Cells(Ro, i * 4 + 35).Value = 0, "", .Cells(Ro, i * 4 + 35).Value & "日") & IIf(.Cells(Ro, i * 4 + 36).Value = 0, "", .Cells(Ro, i * 4 + 36).Value & "時間")
                Else
                ListBox5.List(i + 1, 2) = ""
            End If
            ListBox5.List(i + 1, 1) = "" '◎をクリアする
        Next
        ListBox5.List(14, 2) = ListBox4.List(17, 2)
            ListBox5.List(.Cells(Ro, 12).Value, 1) = "◎" '更新月を選択
        ListBox4.ListIndex = -1
        ListBox5.ListIndex = -1
        TextBox6.Value = ""
    End With
    Set yDataMaster = Nothing
End Sub

Private Sub ListBox3_Click()
    DoEvents
    ListBox1.ListIndex = ListBox3.Value
End Sub
Private Sub ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ListBox3.ListIndex = -1 Then
        MsgBox "社員を選択して実行してください。", 16, "エラー"
        Exit Sub
    End If
    If (ListBox4.ListIndex >= 6 And ListBox4.ListIndex <= 7) Or (ListBox4.ListIndex >= 9 And ListBox4.ListIndex <= 11) Or (ListBox4.ListIndex >= 14 And ListBox4.ListIndex <= 15) Or (ListBox4.ListIndex >= 17 And ListBox4.ListIndex <= 18) Or (ListBox4.ListIndex >= 20 And ListBox4.ListIndex <= 21) Then
        MsgBox "『本年付与日、在職年数、本年分付与日数、繰越限度日数、本年付与月、本年付与合計日数、本年使用日数、現在残日数、時間単位有給データ』は「入社年月日」や「区分」その他から求められる値のため編集することはできません。", 16, "編集不可"
        Exit Sub
    End If
    編集.Label1 = ListBox4.ListIndex '項目のインデックス
    編集.Label4 = ListBox1.ListIndex + 6 '社員情報の行番号
    編集.Label5 = ListBox3.ListIndex 'リストのインデックス
    編集.Show
End Sub
Private Sub ListBox4_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub
    If ListBox4.ListIndex = 3 Then
        Label30.Caption = "「区分４～１」は週、年の所定労働日数が少ないパートタイマー等の付与日数で計算します。その他一般の社員は「一般」を選択してください。"
        ElseIf ListBox4.ListIndex = 6 Then
        Label30.Caption = "本年の有給休暇を付与する（した）年月日です。新入社員で最初の付与日が年をまたぐ場合（7/1以降入社）には入社日が表示されますが翌年以降は正常に表示されます。"
        ElseIf ListBox4.ListIndex = 7 Then
        Label30.Caption = "入社年月日から本年有給休暇を付与する年月までの在職年数です。"
        ElseIf ListBox4.ListIndex = 8 Then
        Label30.Caption = "本年付与する（した）本年分の有給休暇付与日数です。"
        ElseIf ListBox4.ListIndex = 9 Then
        Label30.Caption = "本年付与する（した）際、この日数（前年の付与日数）を限度として繰越すことができる日数です。"
        ElseIf ListBox4.ListIndex = 10 Then
        Label30.Caption = "本年の有給休暇を更新（再付与）する（した）「月」です。"
        ElseIf ListBox4.ListIndex = 11 Then
            If Workbooks("yData.xls").Worksheets("MASTER").Cells(6, 9).Value = False Then
                Label30.Caption = "本年の合計日数（繰越日数と本年分の日数の計）です。「繰越日数」は本年付与月時点の「現在残日数(=前年残日数 － 本年付与月の前月までの使用日数)」と「前年付与日数（繰越限度）」の小さい方。"
                Else
                Label30.Caption = "本年の合計日数（繰越日数と本年分の日数の計）です。「繰越日数」は「前年付与日数（繰越限度）」　-　前年の付与月から本年付与月の前月までの使用日数」と「０」の大きい方。"
            End If
        ElseIf ListBox4.ListIndex = 12 Then
        Label30.Caption = "前年末の残日数です。年が変わり「更新」をおこなうと現在残日数がこの日数となります。"
        ElseIf ListBox4.ListIndex = 13 Then
        Label30.Caption = "前年付与月からの使用日数です。年が変わり「更新」をおこなうと「本年付与月からの日数」がこの日数となります。"
        ElseIf ListBox4.ListIndex = 14 Then
        Label30.Caption = "本年初めから付与月の前月までに使用した日数です。"
        ElseIf ListBox4.ListIndex = 15 Then
        Label30.Caption = "本年の付与月から本年末までに使用した日数です。"
        ElseIf ListBox4.ListIndex = 16 Then
        Label30.Caption = "通常は使用しませんが、本来の現在残日数を変更したい場合、この分をプラスまたはマイナスして調整をおこないます。"
        ElseIf ListBox4.ListIndex = 17 Then
        Label30.Caption = "現在の残日数です。本年付与する前の時点では「前年末残日数－付与する前月までの使用日数」、付与後は「本年合計付与日数－付与月以降に使用した日数」となっています。"""
        ElseIf ListBox4.ListIndex = 18 Then
        Label30.Caption = "時間単位の有給の残時間数です。（年間限度時間－使用時間）"
        ElseIf ListBox4.ListIndex = 19 Then
        Label30.Caption = "一般以外の所定労働時間が短い社員の1日所定労働時間です。"
        ElseIf ListBox4.ListIndex = 20 Then
        Label30.Caption = "時間単位の有給の年間限度時間です。"
        ElseIf ListBox4.ListIndex = 21 Then
        Label30.Caption = "時間単位の有給の使用残時間数です。本年の付与月前は前年付与月から本年の付与月の前月までの使用日数、本年付与月以降は"
            If Workbooks("yData.xls").Worksheets("DATA1").Cells(1, 3).Value < Val(ListBox4.List(10, 1)) Then
                Label30.Caption = "前年の" & ListBox4.List(10, 1) & "月から" & IIf(Val(ListBox4.List(10, 1)) = 1, "１２", "本年" & Val(ListBox4.List(10, 1)) - 1) & "月までの時間単位の有給の使用残時間数です。"
                Else
                Label30.Caption = "本年の" & ListBox4.List(10, 1) & "月からの時間単位の有給の使用残時間数です。"
            End If
        Else
        Label30.Caption = ""
    End If
End Sub

Private Sub ListBox5_Click()
        If ListBox1.ListIndex = -1 Then Exit Sub
        With Workbooks("yData.xls").Worksheets("DATA1")
            TextBox6.Value = .Cells(Ro, ListBox5.ListIndex * 4 + 33).Value '備考を表示
        End With
End Sub

Private Sub UserForm_Initialize()
        Dim i As Integer
        Label27.Caption = Workbooks("yData.xls").Worksheets("MASTER").Cells(4, 9).Value & "年 有給使用状況"
        With Workbooks("yData.xls").Worksheets("DATA1")
            For i = 2 To 20 '社員情報の項目
                If (i >= 8 And i <= 9) Or (i >= 11 And i <= 13) Or (i >= 16 And i <= 20) Then
                    If i = 19 Then
                        ListBox4.AddItem "　" & .Cells(5, i).Value & "(" & .Cells(1, 3).Value & "月時点)"
                        Else
                        ListBox4.AddItem "　" & .Cells(5, i).Value
                    End If
                Else
                ListBox4.AddItem "○" & .Cells(5, i).Value '編集できる項目は「○」をつける
                End If
            Next
            ListBox4.List(9, 0) = "　前年分付与日数（繰越限度）"
            ListBox4.List(12, 0) = "○前年末（12月）残日数"
            ListBox4.List(16, 0) = "○調整日数"
            ListBox4.List(18, 0) = "　時間単位有給の残時間数"
            ListBox4.AddItem "○" & "１日の所定労働時間"
            ListBox4.AddItem "　" & "時間単位の有給限度時間数"
            ListBox4.AddItem "　" & "時間単位の有給使用時間数"
            '#25073
            CreateListbox5
'            ListBox5.AddItem "前年"
'            ListBox5.List(0, 1) = "残"
'            For i = 1 To 12
'                ListBox5.AddItem i & "月" '月を表示する
'            Next
'            ListBox5.AddItem ""
'            ListBox5.AddItem "現在"
'            ListBox5.List(14, 1) = "残"
        End With
        '20140305 ishikawa YB24261
        If Month(Date) = 1 Then
            Label30.Caption = "あけましておめでとうございます。新有給管理では年次更新を行う必要があります。年が変わると年次更新を行う前は残日数が正常に表示されない場合があります。"
        End If
End Sub
Private Sub CreateListbox5()

    Dim i As Long

    ListBox5.Clear

    ListBox5.AddItem "前年"
    ListBox5.List(0, 1) = "残"
    For i = 1 To 12
        ListBox5.AddItem i & "月" '月を表示する
    Next
    ListBox5.AddItem ""
    ListBox5.AddItem "現在"
    ListBox5.List(14, 1) = "残"

End Sub

Attribute VB_Name = "基本情報"
Attribute VB_Base = "0{A29953B3-B994-489E-A418-A180A1776914}{6250E477-3E88-4DBA-AC5F-BBF3A52FA859}"
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()
    基本項目.Show
End Sub
Private Sub CommandButton2_Click()
    日数表.Show
End Sub
Private Sub CommandButton3_Click()
    部.Show
End Sub
Private Sub CommandButton4_Click()
新規作成.Show
End Sub
Private Sub UserForm_Initialize()
    If Worksheets("DATA").Cells(2, 1).Value = 1 Then '台帳版だったら
        Me.Height = 160
    End If
End Sub

Attribute VB_Name = "有給記録"
Attribute VB_Base = "0{6CDB1579-4AF9-44DC-8A02-1A2770F7BF7A}{660F3E55-409F-4836-9CBE-EECB7CDCE908}"
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()
    Dim i As Integer
    Application.Calculation = xlCalculationManual
    With Workbooks("yData.xls").Worksheets("DATA1")
        If .Cells(1, 3).Value <> ComboBox1.ListIndex + 1 Then
            .Cells(1, 3).Value = ComboBox1.ListIndex + 1 '月を代入
            For i = 6 To .Cells(10000, 6).End(xlUp).Row '指定した月で現在残日数を再計算する
                .Cells(i, 19).Value = 現在残日数(i)
                .Cells(i, 20).Value = 現在残時間(i)
            Next
        End If
    End With
    個別入力.月.Caption = ComboBox1.ListIndex
    個別入力.Show
    Unload Me
End Sub
Private Sub CommandButton2_Click()
    Sheets("シート入力").Select
    Cells(4, 10).Value = Workbooks("yData.xls").Worksheets("MASTER").Cells(4, 14).Value '会社名
    Unload Me
End Sub

Private Sub CommandButton3_Click() 'カレンダー入力
    Application.ScreenUpdating = False
    Application.Windows("yData.xls").Visible = True
    DoEvents
    ThisWorkbook.Activate
    DoEvents
    Workbooks("yData.xls").Worksheets("CAL").Activate
    ActiveSheet.EnableSelection = xlUnlockedCells
    ActiveSheet.Protect UserInterfaceOnly:=True
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.DisplayWorkbookTabs = False
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
    Cells(3, 42).Value = Workbooks("yData.xls").Worksheets("MASTER").Cells(4, 14).Value '会社名
    Unload Me
    Application.ScreenUpdating = True
End Sub

Private Sub Label7_Click()
    Call 使用状況へ(1)
End Sub
Private Sub Label8_Click()
    Call 使用状況へ(2)
End Sub
Private Sub Label9_Click()
    Call 使用状況へ(3)
End Sub
Private Sub Label10_Click()
    Call 使用状況へ(4)
End Sub
Private Sub Label11_Click()
    Call 使用状況へ(5)
End Sub
Private Sub Label12_Click()
    Call 使用状況へ(6)
End Sub
Private Sub Label13_Click()
    Call 使用状況へ(7)
End Sub
Private Sub Label14_Click()
    Call 使用状況へ(8)
End Sub
Private Sub Label15_Click()
    Call 使用状況へ(9)
End Sub
Private Sub Label16_Click()
    Call 使用状況へ(10)
End Sub
Private Sub Label17_Click()
    Call 使用状況へ(11)
End Sub
Private Sub Label18_Click()
    Call 使用状況へ(12)
End Sub
Private Sub 使用状況へ(n As Long)
    If Val(Controls("TextBox" & n).Value) = 0 Then
        MsgBox "有給の使用記録はありません。", 16, "使用状況"
        Exit Sub
    End If
    使用状況.Label4.Caption = 30 + 4 * n
    使用状況.Caption = n & "月使用状況"
    使用状況.Show
End Sub

Private Sub UserForm_Activate()
    Dim i As Integer
    With Workbooks("yData.xls").Worksheets("DATA1")
        For i = 1 To 12
            ComboBox1.AddItem i & "月"
            If .Cells(1, 31 + 4 * i).Value <> "" Then
                Controls("TextBox" & i).Value = IIf(InStr(.Cells(1, 31 + 4 * i).Value, ".") > 0, Format(.Cells(1, 31 + 4 * i).Value, "0.00"), .Cells(1, 31 + 4 * i).Value) '使用日数
                Controls("TextBox" & i).BackColor = &HFFFFC0
            End If
        Next
    End With
    ComboBox1.Value = Month(Date) & "月" '現在月を表示する
End Sub



Attribute VB_Name = "並び替え"
Attribute VB_Base = "0{C76ED864-C2B0-4DD5-9329-7550A6066B16}{BD9E17AC-0EF2-42D1-B250-E238D5FD1AB7}"
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()
    Dim 先頭セル As String
    
    If MsgBox("並び替えをおこないますか？", 4 + 32, "並び替え") <> 6 Then Exit Sub
    With Workbooks("yData.xls").Worksheets("DATA1")
        '部門、部課、Noの空欄を「0」にする（空白だとそれは並び替えをおこなうと末尾にきてしまうから）
        On Error Resume Next
        .Range("C6:E" & .Cells(10000, 6).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Value = 0
        On Error GoTo 0
        '20100729 範囲がCCまでになっていた　重
        If OptionButton1.Value = True Then '部門部課は2つの並び替えをおこなうため
            .Range("B6:CD" & .Cells(10000, 6).End(xlUp).Row).Sort Key1:=.Range("C6"), Order1:=xlAscending, Key2:=.Range("D6") _
                , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
                Orientation:=xlTopToBottom, SortMethod:=xlPinYin
            Unload Me
            Exit Sub
        End If
        If OptionButton2.Value = True Then
            先頭セル = "B6"
            ElseIf OptionButton3.Value = True Then
            先頭セル = "G6"
            ElseIf OptionButton4.Value = True Then
            先頭セル = "L6"
            ElseIf OptionButton5.Value = True Then
            先頭セル = "E6"
        End If
        '20100729 範囲がCCまでになっていた　重
        .Range("B6:CD" & .Cells(10000, 6).End(xlUp).Row).Sort Key1:=.Range(先頭セル), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
            :=xlPinYin
    End With
    Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Call 社員情報のリスト表示
End Sub


Attribute VB_Name = "削除"
Attribute VB_Base = "0{78A3C8FB-D600-4132-96B0-DE66CD798B0D}{3DB2AB4A-777D-4210-A590-6AB9FF29554B}"
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 CommandButton3_Click()
    Dim 削除シート As Worksheet
    Set 削除シート = Workbooks("yData.xls").Worksheets("DATA2")
    Dim i As Integer
        Dim n As Integer
        n = 0
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.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
    
    
    n = 削除シート.Cells(10000, 6).End(xlUp).Row + 1
    With Workbooks("yData.xls").Worksheets("DATA1")
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                削除シート.Cells(n, 1).Value = Date
                削除シート.Range("B" & n & ":CD" & n).Value = .Range("B" & i + 6 & ":CD" & i + 6).Value2
                n = n + 1
            End If
        Next
    End With
    
    With Workbooks("yData.xls").Worksheets("DATA1")
        For i = ListBox1.ListCount - 1 To 0 Step -1
            If ListBox1.Selected(i) = True Then
                .Rows(i + 6).Delete
            End If
        Next
    End With
    Unload Me
End Sub

Private Sub CommandButton4_Click()
    If Workbooks("yData.xls").Worksheets("DATA1").Cells(6, 6).Value = "" Then
        MsgBox "削除データは存在しません。", 16, "エラー"
        Exit Sub
    End If
    削除D.Show
End Sub
'20100823 kon
'Private Sub UserForm_Activate()
Private Sub UserForm_Initialize()
    
    Dim i As Integer
    With Workbooks("yData.xls").Worksheets("DATA1")
        For i = 6 To .Cells(10000, 6).End(xlUp).Row
            ListBox1.AddItem .Cells(i, 2).Text
            ListBox1.List(i - 6, 1) = .Cells(i, 6).Text
        Next
    End With
End Sub
Private Sub CommandButton2_Click()
    If Trim(TextBox5.Value) = "" Then
        MsgBox "検索する文字を入力してください。", 16, "エラー"
        Exit Sub
    End If
    Dim i As Integer
    Dim n As Integer
    n = 0
    With ListBox1
        For i = 0 To .ListCount - 1
            If ListBox1.List(i, 0) & ListBox1.List(i, 1) Like "*" & TextBox5.Value & "*" Then
                ListBox1.Selected(i) = True
                n = n + 1
                Else
                ListBox1.Selected(i) = False
            End If
        Next
    End With
    If n = 0 Then
        MsgBox "見つかりませんでした。", 16, "検索"
        Else
        MsgBox n & "件見つかりました。", 64, "検索"
    End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Call 社員情報のリスト表示
End Sub


Attribute VB_Name = "OVER"
Attribute VB_Base = "0{1A0C9125-7208-4799-99F9-07389B6B1512}{A3DF77F3-8F3B-444E-B953-3181EA924019}"
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 i As Integer
    Dim n As Integer
    n = 0
    Dim k

    With Workbooks("yData.xls").Worksheets("MASTER")
        k = .Cells(7, 9).Value * .Cells(8, 9).Value '時間単位の限度時間
    End With
    With Workbooks("yData.xls").Worksheets("DATA1")
        For i = 6 To .Cells(10000, 6).End(xlUp).Row
            If .Cells(i, 19).Value < 0 Or .Cells(i, 20).Value > k Then '残日数が0または時間単位の時間が限度時間をこえていたら
                ListBox1.AddItem .Cells(i, 2).Text
                ListBox1.List(n, 1) = .Cells(i, 6).Text
                ListBox1.List(n, 2) = .Cells(i, 19).Text
                ListBox1.List(n, 3) = .Cells(i, 20).Text
                n = n + 1
            End If
        Next
    End With
End Sub

Attribute VB_Name = "Module2"
Option Explicit
Sub MENU戻るへ()
    Application.ScreenUpdating = False
    Application.Windows("yData.xls").Visible = False
    ThisWorkbook.Activate
    Sheets("MENU").Select
    Application.ScreenUpdating = True
End Sub
Sub 入力表印刷()
    Application.ScreenUpdating = False
    Dim n As Long
    If MsgBox("プリンタの準備はいいですか？", 4 + 32, "印刷") <> 6 Then Exit Sub
    n = 48
    If Cells(10000, 5).End(xlUp).Row >= 48 Then
        n = Cells(10000, 5).End(xlUp).Row
    End If
    DoEvents
    Range("B6:AP" & n).PrintOut
    DoEvents
    Application.ScreenUpdating = True
End Sub
Sub 入力表作成()
    入力表.Show
End Sub
Sub 入力表登録()
    If Trim(Cells(6, 5).Value) = "" Then
        MsgBox "データが登録されてません。", 16, "エラー"
        Else
…

Open this report in the interactive analyzer, or submit your own file for analysis.