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)
    On Error Resume Next
    '単体用
    Application.CommandBars("Worksheet Menu Bar").Controls("カレンダー").Delete
    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 = "読込F"
Attribute VB_Base = "0{A294F582-127E-47E4-AEC2-DE17D39DEB91}{B4994280-B0F6-4CDA-854D-1CAC6045AE5B}"
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 da As String
Dim FoD As String
Private Sub CommandButton1_Click()
    If ListBox1.ListIndex = -1 Then
        MsgBox "リストが選択されていません", 16, AAA
        Exit Sub
    End If
    Label3.Visible = True
    Me.Repaint
    Application.ScreenUpdating = False
    Workbooks.Open FoD & ListBox1.Value & da
    If Cells(66, 3).Value = "休日" Then '旧のデータでなければ
        ThisWorkbook.Worksheets("カレンダー").Activate
        With Workbooks(ListBox1.Value & da).Worksheets("Sheet1")
            Range("AL1:AY3").Value = .Range("AL1:AY3").Value2
            .Range("B5:AA75").Copy
            Range("B5:AA75").PasteSpecial Paste:=xlAll
            Range("AK135:AR161").Value = .Range("AK135:AR161").Value2
        End With
        Cells(78, 27).Value = Cells(8, 27).Value '会社名（再計算する場合があるため下のほうも変更しておく）
        Application.CutCopyMode = False
        Workbooks(ListBox1.Value & da).Close False
        ThisWorkbook.Activate
        Cells(2, 2).Select
        If CheckBox1.Value = True Then '次の年を新規作成
        Range("AK135:AR161").ClearContents '限度チェックデータ
        Cells(3, 38).Value = DateSerial(Year(Cells(3, 38).Value) + 1, Month(Cells(3, 38).Value), Day(Cells(3, 38).Value))
        '20120307 重
        If Month(Cells(3, 38).Value) = 1 And Day(Cells(3, 38).Value) = 1 Then
            Cells(5, 2).Value = "年 間 休 日 カ レ ン ダ ー"
            Else
            Cells(5, 2).Value = Year(Cells(3, 38).Value) & "年～" & Year(Cells(3, 38).Value) + 1 & "年 休 日 カ レ ン ダ ー"
        End If

        Cells(80, 3).Value = Cells(10, 3).Value
        Call カレンダー作成
        Call 休日色設定
        Else
        Worksheets("計算シート").Range("AN135:AR147").Value = Range("E8:I20").Value2
        Worksheets("計算シート").Range("AN149:AR161").Value = Range("E45:I57").Value2
        End If
    Else
        Workbooks(ListBox1.Value & da).Close False
        ThisWorkbook.Activate
        MsgBox "この保存データは適用できません。", 16, AAA
        Exit Sub
    End If
    Unload Me
    Application.ScreenUpdating = True
    MsgBox "OK", 64, AAA
End Sub
Private Sub CommandButton2_Click()
    If ListBox1.ListIndex = -1 Then
        MsgBox "ファイルが選択されていません", 16, AAA
        Exit Sub
    End If
    If MsgBox(ListBox1.Value & "を削除してもいいですか？", 1 + 32, "削除") <> 1 Then Exit Sub
    Kill FoD & ListBox1.Value & da
    ListBox1.RemoveItem ListBox1.ListIndex
    MsgBox "削除しました", 64, AAA
End Sub
'20091113 kon
'Private Sub Frame1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'    If MsgBox("旧バージョンの「保存データ」を読み込みますか？", 4 + 32, "読込") <> 6 Then Exit Sub
'    Unload Me
'    Application.ScreenUpdating = False
'    Da保存読込.Show
'    Application.ScreenUpdating = True
'End Sub
'20091113 kon
Private Sub CommandButton3_Click()
    If MsgBox("旧バージョンの「保存データ」を読み込みますか？", 4 + 32, "読込") <> 6 Then Exit Sub
    Unload Me
    Application.ScreenUpdating = False
    Da保存読込.Show
    Application.ScreenUpdating = True
End Sub
Private Sub Label1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim ファイル名 As String '20091215　追加　重（すべての保存データのリスト表示用）
    ListBox1.Clear
    ファイル名 = Dir(FoD & "*" & da)
    Do While ファイル名 <> ""
        With ListBox1
            .AddItem Left(ファイル名, Len(ファイル名) - Len(da))  '
            ファイル名 = Dir()
        End With
    Loop
End Sub

Private Sub UserForm_Activate()
    If ThisWorkbook.Worksheets("DATA").Cells(2, 1) = 1 Then
        da = Worksheets("DATA").Cells(1, 1).Value
        FoD = ThisWorkbook.Path & "\Da保存\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & "\"
        Else
        da = " カレンダー カレンダー.xls"
        FoD = ThisWorkbook.Path & "\Da保存\"
    End If
    Dim ファイル名 As String
    ファイル名 = Dir(FoD & "2???年  *" & da)
    Do While ファイル名 <> ""
        With ListBox1
            .AddItem Left(ファイル名, Len(ファイル名) - Len(da))  '
            ファイル名 = Dir()
        End With
    Loop
End Sub

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 = "Sheet9"
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 = "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

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Call 休日に

End Sub


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


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


Attribute VB_Name = "Sheet8"
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{4C722321-1B9C-4A59-A75A-361CFC9E0437}{0C0FB53E-6013-4E99-AF48-AA49C62FC250}"
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 IsDate(TextBox1.Value) = False Then
        MsgBox "初日の日付データが不正です。", 16, AAA
        Exit Sub
    End If
    If Day(DateValue(TextBox1.Value)) > 28 Then
        MsgBox "29日以降の初日の日付データは作成できません。", 16, AAA
        Exit Sub
    End If
    If IsDate(TextBox3.Value) = False Then
        MsgBox "一日所定労働時間データが不正です。", 16, AAA
        Exit Sub
    End If
    Range("AK135:AR161").ClearContents '限度チェックのデータを一旦クリア
    Range("X67:AA75").ClearContents '集計データをクリア
    Cells(71, 24).Value = TextBox3.Value '一日所定労働時間
    Cells(78, 27).Value = TextBox2.Value '会社名
    Cells(80, 3).Value = ComboBox1.ListIndex + 1
    Cells(3, 38).Value = TextBox1.Value '初日
'    20101021masa 年をまたぐ場合がわかりずらい、要望によりタイトルに年の情報を表示
    If Month(TextBox1.Value) = 1 And Day(TextBox1.Value) = 1 Then
        Cells(5, 2).Value = "年 間 休 日 カ レ ン ダ ー"
        Else
        Cells(5, 2).Value = Year(TextBox1.Value) & "年～" & Year(TextBox1.Value) + 1 & "年 休 日 カ レ ン ダ ー"
    End If

    Cells(3, 39).Value = CheckBox1.Value '祝日表示
    Call カレンダー作成
    Unload Me
    If MsgBox("続いて「休日」を指定しますか？", 4 + 32, AAA) <> 6 Then Exit Sub
    休日指定.Show 0
End Sub

Private Sub CommandButton2_Click()
パレット.Show
End Sub

Private Sub UserForm_Activate()
    Application.Calculation = xlCalculationManual
    ComboBox1.AddItem "日曜日"
    ComboBox1.AddItem "月曜日"
    ComboBox1.AddItem "火曜日"
    ComboBox1.AddItem "水曜日"
    ComboBox1.AddItem "木曜日"
    ComboBox1.AddItem "金曜日"
    ComboBox1.AddItem "土曜日"
    If Trim(Cells(8, 27).Value) = "" And Worksheets("DATA").Cells(2, 1).Value = 1 Then '初めての作成で台帳版だったら
        With Workbooks(Worksheets("DATA").Cells(1, 1).Value).Worksheets("会社情報")
            TextBox2.Value = .Cells(8, 2).Value '会社名
            TextBox1.Value = DateSerial(Year(Date), 1, 1) '初日
            TextBox3.Value = Format(.Cells(29, 2).Value, "h:mm") '一日所定労働時間
            ComboBox1.ListIndex = 0 '最初の曜日
            CheckBox1.Value = True '祝日表示
        End With
    ElseIf Trim(Cells(8, 27).Value) = "" Then '初めての作成だったら
            TextBox2.Value = "○○株式会社" '会社名
            TextBox1.Value = DateSerial(Year(Date), 1, 1) '初日
            TextBox3.Value = "8:00" '一日所定労働時間
            ComboBox1.ListIndex = 0 '最初の曜日
            CheckBox1.Value = True '祝日表示
    Else
        TextBox2.Value = Cells(8, 27).Value '会社名
        TextBox1.Value = Cells(3, 38).Value '初日
        TextBox3.Value = Format(Cells(71, 24).Value, "h:mm") '一日所定労働時間
        ComboBox1.ListIndex = Cells(10, 3).Value - 1 '最初の曜日
        CheckBox1.Value = Cells(3, 39).Value '祝日表示
    End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Calculation = xlCalculationAutomatic
End Sub


Attribute VB_Name = "Module1"
'************************
'修正履歴：
'旧データを読み込むボタンがややこしいので変更V8.06出荷後に変更前は保存データの読込の枠をダブルクリックして呼び出した　　20091113 kon
'保存データの形式が複数あるため、新しいファイル以外すべて読み込むように変更　20091119 kon
'　V4.01：ううう 20090101  カレンダー.xls　V4.00：カレンダー　セルズda カレンダー.xls　 V3.42：カレンダー カレンダー.xls
'保存する時に、 hozonfile.xlsが存在するのに見つけられない場合があるため修正　20091221 kon

'************************
Option Explicit
Public Const AAA As String = "年間休日カレンダー"
'-----------20091030 kon
Type BROWSEINFO
    hWndOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As String
    iImage As Long
End Type
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidl As Long, ByVal pszPath As String) As Long

Public Const CSIDL_DESKTOP = &H0              'デスクトップ
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_RETURNONLYFSDIRS = &H1            'フォルダのみ選択可能
'-----------20091030 kon　end

'---------出荷時は必ずクリアすること--------------
Sub KURIA()
    Sheets("カレンダー").Select
    Range("B8:C8,AA8,B10:AA64,B67:R75,X67:AA75").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0
    Selection.ClearContents
    Range("E66").Select
    Selection.Interior.ColorIndex = 3

    Sheets("計算シート").Select
    Range( _
        "G5:I5,E8:F8,H8:I8,E10:F21,D28:H39,H45:H55,E57:F57,H57:I57,C117:I222,C316:I434" _
        ).ClearContents
    Range("B2").Activate
    Sheets("カレンダー").Select
    Range("AK135:AR161").ClearContents
    Range("B2").Activate
    ActiveWindow.ScrollRow = 1

End Sub
Sub 初期処理()
    Call Syokisyori
    Worksheets("DATA").Cells(2, 1).Value = 1 '台帳印
    ThisWorkbook.Saved = True
End Sub
Sub Auto_Open()
    Call Syokisyori
    Worksheets("DATA").Cells(2, 1).Value = 2 '単体印
    Control_Make
    ThisWorkbook.Saved = True
End Sub
Sub 初期処理R()
    Worksheets("DATA").Cells(2, 1).Value = 3 '労使協定印
    Worksheets("MENU").Select
    Cells(7, 4).Select
    ActiveWindow.DisplayWorkbookTabs = False
    Application.ScreenUpdating = True
    ThisWorkbook.Saved = True
End Sub
Sub Control_Make()  'コントロール作成用
    Dim o_cmdbar As CommandBarControl
    On Error Resume Next
    Application.CommandBars("Worksheet Menu Bar").Controls("カレンダー").Delete
    On Error GoTo 0
    Set o_cmdbar = Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup)
    o_cmdbar.Caption = "カレンダー"
    With o_cmdbar.Controls.Add(Type:=msoControlButton)
            .Caption = "ファイル出力"
            .FaceId = 620
            .OnAction = "F出力へ"
    End With
End Sub
Sub F出力へ()
    F出力.Show
End Sub
Sub Syokisyori()
    Application.ScreenUpdating = False
    Dim s As Worksheet
      For Each s In Worksheets
        With s
          .Activate
          .EnableSelection = xlUnlockedCells
          .Protect UserInterfaceOnly:=True
           ActiveWindow.DisplayHeadings = False
        End With
      Next
    Worksheets("MENU").Select
    Cells(6, 4).Select
    ActiveWindow.DisplayWorkbookTabs = False
    Application.ScreenUpdating = True
    
End Sub
Sub 作成へ()
作成.Show
End Sub
Sub 休日指定へ()
    If Cells(8, 2).Value = 0 Then
        MsgBox "カレンダーを作成してから実行してください。", 16, AAA
        Exit Sub
    End If

    休日指定.Show 0
End Sub
Sub 印刷へ()
    If MsgBox("プリンタの準備はいいですか？", 4 + 32, "印刷") <> 6 Then Exit Sub
    DoEvents
    ActiveSheet.PrintOut
    DoEvents
End Sub
Sub MENUへ()
Sheets("MENU").Select
End Sub
Sub HELPへ()
Sheets("HELP").Select
End Sub
Sub 休日表へ()
Sheets("カレンダー").Select
End Sub
Sub 計算シートへ()
    If Worksheets("カレンダー").Cells(8, 2).Value = 0 Then
        MsgBox "休日カレンダーを作成してから実行してください。", 16, AAA
        Exit Sub
    End If

    Sheets("計算シート").Select
End Sub
Sub ついてへ()
    Sheets("ついて").Select
End Sub
Sub ついてへ2()
    Sheets("ついて2").Select
End Sub
Sub カレンダー2()
    Dim s As Workbook
    If Worksheets("カレンダー").Cells(67, 24).Value = 0 Then
        MsgBox "休日カレンダーを作成してから実行してください。", 16, AAA
        Exit Sub
    End If

    For Each s In Workbooks
    If s.Name = "cale2.xls" Then
        s.Activate
        Exit Sub
    End If
    Next
    Application.ScreenUpdating = False
    Workbooks.Open ThisWorkbook.Path & "\cale2.xls"
    Application.Run ActiveWorkbook.Name & "!初期処理"
End Sub
Sub カレンダー3()
    Dim s As Workbook
    If Worksheets("カレンダー").Cells(67, 24).Value = 0 Then
        MsgBox "休日カレンダーを作成してから実行してください。", 16, AAA
        Exit Sub
    End If

    For Each s In Workbooks
    If s.Name = "cale3.xls" Then
        s.Activate
        Exit Sub
    End If
    Next
    Application.ScreenUpdating = False
    Workbooks.Open ThisWorkbook.Path & "\cale3.xls"
    If Workbooks("cale3.xls").BuiltinDocumentProperties("Keywords").Value <> 2010 Then
        Application.Run "DaAddin.xla!モジュール入替2010", "cale3.xls"
    End If

    Application.Run ActiveWorkbook.Name & "!初期処理"
End Sub
Sub カレンダー4()
    Dim s As Workbook
    If Worksheets("カレンダー").Cells(8, 2).Value = 0 Then
        MsgBox "休日カレンダーを作成してから実行してください。", 16, AAA
        Exit Sub
    End If
    For Each s In Workbooks
    If s.Name = "cale4.xls" Then
        s.Activate
        Exit Sub
    End If
    Next
    Application.ScreenUpdating = False
    Workbooks.Open ThisWorkbook.Path & "\cale4.xls"
    Application.Run ActiveWorkbook.Name & "!初期処理"
End Sub

Sub 終了へ()
    If ThisWorkbook.Saved = True Then
        ThisWorkbook.Close False
        Exit Sub
    End If
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = True
    Dim WB As Object, ブックの数 As Integer
    ブックの数 = 0
    For Each WB In Application.Workbooks
        If UCase(WB.Name) Like "PERSONAL*" Then
            Else
            ブックの数 = ブックの数 + 1
        End If
    Next
    If MsgBox("終了しますか", 4 + 32, AAA) <> 6 Then Exit Sub
    If ブックの数 = 1 Then
        Application.Quit
    Else
        Application.OnTime Now + TimeValue("00:00:01"), "CloseThisWorkbook"

    End If

End Sub
Sub CloseThisWorkbook()
   ThisWorkbook.Close False
End Sub
Sub 休日に()
    With ActiveCell
        If IsDate(.Value) = True Then
            If .Interior.ColorIndex = Cells(66, 5).Interior.ColorIndex And .Font.ColorIndex = Cells(66, 5).Font.ColorIndex Then
                .Interior.ColorIndex = xlNone
                .Font.ColorIndex = 0
                .Offset(1, 0).Interior.ColorIndex = xlNone
                .Offset(1, 0).Font.ColorIndex = 0
                With 休日指定
                    If .Label30.Caption <> "" Then
                        .Label31.Caption = Val(.Label31.Caption) + 1
                        .Label30.Caption = IIf(.Label31.Caption < 1, "40時間達成" & Chr(10) & "「計算」して下さい。", "あと " & .Label31.Caption & " 日必要")
                    End If
                End With
            Else
                .Interior.ColorIndex = Cells(66, 5).Interior.ColorIndex
                .Font.ColorIndex = Cells(66, 5).Font.ColorIndex
                .Offset(1, 0).Interior.ColorIndex = Cells(66, 5).Interior.ColorIndex
                .Offset(1, 0).Font.ColorIndex = Cells(66, 5).Font.ColorIndex
                With 休日指定
                    If .Label30.Caption <> "" Then
                        .Label31.Caption = Val(.Label31.Caption) - 1
                        .Label30.Caption = IIf(.Label31.Caption < 1, "40時間達成" & Chr(10) & "「計算」して下さい。", "あと " & .Label31.Caption & " 日必要")
                    End If
                End With
            End If
        .Offset(1, 0).Select
        Else
        MsgBox "日付のセルで実行してください。", 16, AAA
        End If
    End With
End Sub
Sub チェックへ()
    If Worksheets("カレンダー").Cells(67, 24).Value = 0 Then
        MsgBox "年間休日カレンダーを作成してからおこなってください。", 16, AAA
        Exit Sub
    End If
    チェック.Show
End Sub
Sub 作成と保存()
    If Cells(8, 2).Value = 0 Then
        MsgBox "カレンダーを作成してから実行してください。", 16, AAA
        Exit Sub
    End If
    If Cells(135, 37).Value = "" Then
        If MsgBox("このカレンダーは「限度チェック」が行われていません。限度チェックデータも保存を行いますがこのまま保存してもいいですか？", 4 + 48, "保存") <> 6 Then Exit Sub
    Else
        If MsgBox("このデータを保存しますか？", 4 + 32, "保存") <> 6 Then Exit Sub
    End If
    Application.ScreenUpdating = False
    Call 保存
End Sub
Sub 読込()
読込F.Show
End Sub
Sub 保存()
    Da保存.Show
End Sub
'20091030 kon
Public Function GetFolder(strComent As String, strPath As String) As Boolean

    Dim bif     As BROWSEINFO
    Dim pidl    As Long
    Dim hWnd    As Long
    
    On Error GoTo ErrGetFolder

    With bif
        .hWndOwner = hWnd
        .pidlRoot = CSIDL_DESKTOP
        .ulFlags = BIF_RETURNONLYFSDIRS
        .lpszTitle = strComent
    End With

    pidl = SHBrowseForFolder(bif)

    If pidl <> 0 Then
        strPath = String$(256, vbNullChar)
        SHGetPathFromIDList pidl, strPath
        strPath = Left(strPath, InStr(strPath, vbNullChar) - 1)
        GetFolder = True
    Else
        GetFolder = False
    End If
     
    Exit Function
     
ErrGetFolder:
    GetFolder = False

End Function

Attribute VB_Name = "パレット"
Attribute VB_Base = "0{3699F5CA-6602-494F-B6FA-E4D84AE81CDF}{1313A680-D863-4E9B-BCD4-5023C7B0DC32}"
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 ComboBox1_Change()
'    Dim n As Integer
'    n = ComboBox1.ListIndex
'    With Command色
'        If n = 0 Then
'            .BackColor = Cells(66, 5).Interior.Color
'            .ForeColor = Cells(66, 5).Font.Color
'            TextBox1.Value = ""
'            Label11.Visible = False
'        ElseIf n <= 4 Then
'            If Trim(Cells(67 + n * 2, 6).Value) <> "" And IsNumeric(Cells(67 + n * 2, 6).Value) Then
'                .BackColor = Cells(67 + n * 2, 5).Interior.Color
'                .ForeColor = Cells(67 + n * 2, 5).Font.Color
'                TextBox1.Value = Format(Cells(67 + n * 2, 6).Value, "h:mm")
'                Label11.Visible = False
'            Else
'                .BackColor = &H8000000F
'                .ForeColor = &H80000012
'                TextBox1.Value = ""
'                Label11.Visible = True
'            End If
'        Else
'            If Trim(Cells(59 + n * 2, 13).Value) <> "" And IsNumeric(Cells(59 + n * 2, 13).Value) Then
'                .BackColor = Cells(59 + n * 2, 12).Interior.Color
'                .ForeColor = Cells(59 + n * 2, 12).Font.Color
'                TextBox1.Value = Format(Cells(59 + n * 2, 13).Value, "h:mm")
'                Label11.Visible = False
'            Else
'
'                .BackColor = &H8000000F
'                .ForeColor = &H80000012
'                TextBox1.Value = ""
'                Label11.Visible = True
'            End If
'        End If
'    End With
'End Sub

Private Sub CommandButton43_Click()
    Dim n As Integer
    
    Cells(66, 5).Interior.Color = Command0.BackColor
    Cells(66, 5).Font.Color = Command0.ForeColor
    For n = 1 To 8
        If Controls("Check" & n).Value = True Then
            If n <= 4 Then
                Cells(67 + n * 2, 3).Value = "時間" & StrConv(n, vbWide)
                Cells(67 + n * 2, 5).Value = n
                Cells(67 + n * 2, 5).Interior.Color = Controls("Command" & n).BackColor
                Cells(67 + n * 2, 5).Font.Color = Controls("Command" & n).ForeColor
                Cells(67 + n * 2, 6).Value = Controls("Text" & n).Value
            Else
                Cells(59 + n * 2, 9).Value = "時間" & StrConv(n, vbWide)
                Cells(59 + n * 2, 12).Value = n
                Cells(59 + n * 2, 12).Interior.Color = Controls("Command" & n).BackColor
                Cells(59 + n * 2, 12).Font.Color = Controls("Command" & n).ForeColor
                Cells(59 + n * 2, 13).Value = Controls("Text" & n).Value
            End If
        Else
            If n <= 4 Then
                Cells(67 + n * 2, 3).ClearContents
                Cells(67 + n * 2, 5).ClearContents
                Cells(67 + n * 2, 5).Interior.ColorIndex = xlNone
                Cells(67 + n * 2, 6).Value = ""
            Else
                Cells(59 + n * 2, 9).ClearContents
                Cells(59 + n * 2, 12).ClearContents
                Cells(59 + n * 2, 12).Interior.ColorIndex = xlNone
                Cells(59 + n * 2, 13).Value = ""
            End If
        
        End If
    Next
    Cells(67, 2).Value = IIf(Cells(69, 3).Value = "", "", "所定労働時間以外の労働時間")
    
    Unload Me
End Sub

'Private Sub CommandButton45_Click()
'MsgBox IsDate(TextBox1.Value)
'End Sub

Private Sub UserForm_Initialize()
    CommandButton1.BackColor = RGB(0, 0, 0)
    CommandButton2.BackColor = RGB(153, 51, 0)
    CommandButton3.BackColor = RGB(51, 51, 0)
    CommandButton4.BackColor = RGB(0, 51, 0)
    CommandButton5.BackColor = RGB(0, 51, 102)
    CommandButton6.BackColor = RGB(0, 0, 128)
    CommandButton7.BackColor = RGB(51, 51, 153)
    CommandButton8.BackColor = RGB(51, 51, 51)
    CommandButton9.BackColor = RGB(128, 0, 0)
    CommandButton10.BackColor = RGB(255, 102, 0)
    CommandButton11.BackColor = RGB(128, 128, 0)
    CommandButton12.BackColor = RGB(0, 128, 0)
    CommandButton13.BackColor = RGB(0, 128, 128)
    CommandButton14.BackColor = RGB(0, 0, 255)
    CommandButton15.BackColor = RGB(102, 102, 153)
    CommandButton16.BackColor = RGB(128, 128, 128)
    CommandButton17.BackColor = RGB(255, 0, 0)
    CommandButton18.BackColor = RGB(255, 153, 0)
    CommandButton19.BackColor = RGB(153, 204, 0)
    CommandButton20.BackColor = RGB(51, 153, 102)
    CommandButton21.BackColor = RGB(51, 204, 204)
    CommandButton22.BackColor = RGB(51, 102, 255)
    CommandButton23.BackColor = RGB(128, 0, 128)
    CommandButton24.BackColor = RGB(150, 150, 150)
    CommandButton25.BackColor = RGB(255, 0, 255)
    CommandButton26.BackColor = RGB(255, 204, 0)
    CommandButton27.BackColor = RGB(255, 255, 0)
    CommandButton28.BackColor = RGB(0, 255, 0)
    CommandButton29.BackColor = RGB(0, 255, 255)
    CommandButton30.BackColor = RGB(0, 204, 255)
    CommandButton31.BackColor = RGB(153, 51, 102)
    CommandButton32.BackColor = RGB(192, 192, 192)
    CommandButton33.BackColor = RGB(255, 153, 204)
    CommandButton34.BackColor = RGB(255, 204, 153)
    CommandButton35.BackColor = RGB(255, 255, 153)
    CommandButton36.BackColor = RGB(204, 255, 204)
    CommandButton37.BackColor = RGB(204, 255, 255)
    CommandButton38.BackColor = RGB(153, 204, 255)
    CommandButton39.BackColor = RGB(204, 153, 255)
    CommandButton40.BackColor = RGB(255, 255, 255)
    Dim i As Integer
    For i = 1 To 40
        Me.Controls("CommandButton" & i).Caption = ""
    Next i
    Command0.BackColor = Cells(66, 5).Interior.Color
    Command0.ForeColor = Cells(66, 5).Font.Color
    
    If Cells(69, 3).Value = "時間１" Then
        Command1.BackColor = Cells(69, 5).Interior.Color
        Command1.ForeColor = Cells(69, 5).Font.Color
        Text1.Value = Cells(69, 6).Text
        Check1.Value = True
        Else
        Command1.BackColor = RGB(204, 255, 204)
        Command1.ForeColor = RGB(0, 0, 0)
    End If
    If Cells(71, 3).Value = "時間２" Then
        Command2.BackColor = Cells(71, 5).Interior.Color
        Command2.ForeColor = Cells(71, 5).Font.Color
        Text2.Value = Cells(71, 6).Text
        Check2.Value = True
        Else
        Command2.BackColor = RGB(204, 255, 255)
        Command2.ForeColor = RGB(0, 0, 0)
    End If
    If Cells(73, 3).Value = "時間３" Then
        Command3.BackColor = Cells(73, 5).Interior.Color
        Command3.ForeColor = Cells(73, 5).Font.Color
        Text3.Value = Cells(73, 6).Text
        Check3.Value = True
        Else
        Command3.BackColor = RGB(153, 204, 255)
        Command3.ForeColor = RGB(0, 0, 0)
    End If
    If Cells(75, 3).Value = "時間４" Then
        Command4.BackColor = Cells(75, 5).Interior.Color
        Command4.ForeColor = Cells(75, 5).Font.Color
        Text4.Value = Cells(75, 6).Text
        Check4.Value = True
        Else
        Command4.BackColor = RGB(255, 255, 153)
        Command4.ForeColor = RGB(0, 0, 0)
    End If
    If Cells(69, 9).Value = "時間５" Then
        Command5.BackColor = Cells(69, 12).Interior.Color
        Command5.ForeColor = Cells(69, 12).Font.Color
        Text5.Value = Cells(69, 13).Text
        Check5.Value = True
        Else
        Command5.BackColor = RGB(0, 255, 0)
        Command5.ForeColor = RGB(0, 0, 0)
    End If
    If Cells(71, 9).Value = "時間６" Then
        Command6.BackColor = Cells(71, 12).Interior.Color
        Command6.ForeColor = Cells(71, 12).Font.Color
        Text6.Value = Cells(71, 13).Text
        Check6.Value = True
        Else
        Command6.BackColor = RGB(51, 102, 255)
        Command6.ForeColor = RGB(255, 255, 255)
    End If
    If Cells(73, 9).Value = "時間７" Then
        Command7.BackColor = Cells(73, 12).Interior.Color
        Command7.ForeColor = Cells(73, 12).Font.Color
        Text7.Value = Cells(73, 13).Text
        Check7.Value = True
        Else
        Command7.BackColor = RGB(51, 153, 102)
        Command7.ForeColor = RGB(255, 255, 255)
    End If
    If Cells(75, 9).Value = "時間８" Then
        Command8.BackColor = Cells(75, 12).Interior.Color
        Command8.ForeColor = Cells(75, 12).Font.Color
        Text8.Value = Cells(75, 13).Text
        Check8.Value = True
        Else
        Command8.BackColor = RGB(153, 51, 0)
        Command8.ForeColor = RGB(255, 255, 255)
    End If
End Sub
Private Sub CommandButton1_Click()
    実行 (1)
End Sub
Private Sub CommandButton2_Click()
    実行 (2)
End Sub
Private Sub CommandButton3_Click()
    実行 (3)
End Sub
Private Sub CommandButton4_Click()
    実行 (4)
End Sub
Private Sub CommandButton5_Click()
    実行 (5)
End Sub
Private Sub CommandButton6_Click()
    実行 (6)
End Sub
Private Sub CommandButton7_Click()
    実行 (7)
End Sub
Private Sub CommandButton8_Click()
    実行 (8)
End Sub
Private Sub CommandButton9_Click()
    実行 (9)
End Sub
Private Sub CommandButton10_Click()
    実行 (10)
End Sub
Private Sub CommandButton11_Click()
    実行 (11)
End Sub
Private Sub CommandButton12_Click()
    実行 (12)
End Sub
Private Sub CommandButton13_Click()
    実行 (13)
End Sub
Private Sub CommandButton14_Click()
    実行 (14)
End Sub
Private Sub CommandButton15_Click()
    実行 (15)
End Sub
Private Sub CommandButton16_Click()
    実行 (16)
End Sub
Private Sub CommandButton17_Click()
    実行 (17)
End Sub
Private Sub CommandButton18_Click()
    実行 (18)
End Sub
Private Sub CommandButton19_Click()
    実行 (19)
End Sub
Private Sub CommandButton20_Click()
    実行 (20)
End Sub
Private Sub CommandButton21_Click()
    実行 (21)
End Sub
Private Sub CommandButton22_Click()
    実行 (22)
End Sub
Private Sub CommandButton23_Click()
    実行 (23)
End Sub
Private Sub CommandButton24_Click()
    実行 (24)
End Sub
Private Sub CommandButton25_Click()
    実行 (25)
End Sub
Private Sub CommandButton26_Click()
    実行 (26)
End Sub
Private Sub CommandButton27_Click()
    実行 (27)
End Sub
Private Sub CommandButton28_Click()
    実行 (28)
End Sub
Private Sub CommandButton29_Click()
    実行 (29)
End Sub
Private Sub CommandButton30_Click()
    実行 (30)
End Sub
Private Sub CommandButton31_Click()
    実行 (31)
End Sub
Private Sub CommandButton32_Click()
    実行 (32)
End Sub
Private Sub CommandButton33_Click()
    実行 (33)
End Sub
Private Sub CommandButton34_Click()
    実行 (34)
End Sub
Private Sub CommandButton35_Click()
    実行 (35)
End Sub
Private Sub CommandButton36_Click()
    実行 (36)
End Sub
Private Sub CommandButton37_Click()
    実行 (37)
End Sub
Private Sub CommandButton38_Click()
    実行 (38)
End Sub
Private Sub CommandButton39_Click()
    実行 (39)
End Sub
Private Sub CommandButton40_Click()
    実行 (40)
End Sub

Private Sub 実行(n As Integer)
    Dim i As Integer
    For i = 0 To 8
        If Controls("Option" & i).Value = True Then
            If IsDate(Controls("Text" & i).Value) = False Then
                MsgBox "労働時間の入力が不正（入力形式「h:mm」）のため処理を実行できません。", 16, "労働時間"
                Exit Sub
            End If
            If OptionButton1.Value = True Then
                Controls("Command" & i).BackColor = Controls("CommandButton" & n).BackColor
                Else
                Controls("Command" & i).ForeColor = Controls("CommandButton" & n).BackColor
            End If
            Controls("Check" & i).Value = True
            Exit For
        End If
    Next
End Sub


Attribute VB_Name = "Module2"
Option Explicit

…