Malicious Office (OLE) — malware analysis report

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


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


Attribute VB_Name = "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)
    Application.Calculation = xlCalculationAutomatic
    ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
    
    Call シート初期処理
    Worksheets("DATA1").Cells(1, 1).Value = ""
    Cells(5, 2).Value = ""
    Cells(9, 2).Select
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    MsgBox "このファイルは保存できません。", 16, "保存"
    Cancel = True
End Sub




Attribute VB_Name = "modGetSyukujitsu2"
'*******************************************************************************
'   祝日判定処理        ※年月指定により祝日(振休補正後)を配列で返す②
'*******************************************************************************
' 修正日   修正内容------------------------------------------------------------>
' 09/03/01 春分の日の処理で空テーブル要素ができてしまう件を修正
'*******************************************************************************
Option Explicit
Private Const g_cnsFURI = "(振替休日)"
Private Const g_cnsKYU2 = "国民の休日"
' 祝日テーブル(ユーザー定義)
Public Type typSyuku
    dteDate As Date                 ' 日付
    intFuri As Integer              ' 振替休日SW(1=振替休日, 0=通常)
    strName As String               ' 祝日名称
End Type
' 下記処理で作成される祝日テーブル
Public g_tblSyuku() As typSyuku     ' 祝日テーブル(呼び元で利用する)

'*******************************************************************************
' 当該年月の祝日情報のテーブルを作成する(当月1ヶ月用)
'
' 戻り値：祝日テーブルの要素数(マイナス時は祝日なし)
' 引数　：Arg1=年(Integer)
' 　　　　Arg2=月(Integer)
'*******************************************************************************
Public Function FP_GetHoliday1(intY As Integer, _
                               intM As Integer) As Long
    Dim IX As Long              ' 配列のIndex

    ' 配列の初期化(要素数)
    IX = -1
    ReDim g_tblSyuku(0)         ' 一旦､初期化
    ' 祝日情報のテーブルを作成(1ヶ月分共通処理)
    Call GP_GetHolidaySub(intY, intM, IX)
    ' 戻り値のセット
    FP_GetHoliday1 = IX
End Function

'*******************************************************************************
' 前当翌3ヶ月の祝日情報のテーブルを作成する(当月+前後の3ヶ月用)
'
' 戻り値：祝日テーブルの要素数
' 引数　：Arg1=年(Integer)
' 　　　　Arg2=月(Integer)
'*******************************************************************************
Public Function FP_GetHoliday3(intYear As Integer, _
                               intMonth As Integer) As Long
    Dim intY As Integer, intM As Integer
    Dim IX As Long, IX2 As Long
    
    ' 配列の初期化(要素数)
    IX = -1
    ReDim g_tblSyuku(0)         ' 一旦､初期化
    ' 前月の年月を算出
    If intMonth = 1 Then
        intY = intYear - 1
        intM = 12
    Else
        intY = intYear
        intM = intMonth - 1
    End If
    ' 前・当・翌の3ヶ月を繰り返す
    For IX2 = 1 To 3
        ' 祝日情報のテーブルを作成(1ヶ月分共通処理)
        Call GP_GetHolidaySub(intY, intM, IX)
        ' 翌月の年月を算出
        If intM = 12 Then
            intY = intY + 1
            intM = 1
        Else
            intM = intM + 1
        End If
    Next IX2
    ' 戻り値をセット
    FP_GetHoliday3 = IX
End Function

'*******************************************************************************
' ※以下はサブ処理
'*******************************************************************************
' 祝日情報のテーブルを作成(1ヶ月分共通処理)
'
' 戻り値：(なし)
' 引数　：Arg1=年(Integer)
' 　　　　Arg2=月(Integer)
' 　　　　Arg3=テーブル最終位置(Long)  ※直前項目の登録位置
'*******************************************************************************
Private Sub GP_GetHolidaySub(intY As Integer, _
                             intM As Integer, _
                             IX As Long)
    Dim strName As String, strName2 As String
    
    ' 月による分岐
    Select Case intM
        '-----------------------------------------------------------------------
        ' 1月
        Case 1
            ' 元旦(1/1)
            Call GP_GetHolidaySub2(DateSerial(intY, intM, 1), IX, "元旦")
            ' 成人の日
            strName = "成人の日"
            If intY < 2000 Then
                ' 1999年までは15日固定
                Call GP_GetHolidaySub2(DateSerial(intY, intM, 15), IX, strName)
            Else
                ' 2000年以降は第2月曜日
                Call GP_GetHolidaySub3(intY, intM, 2, 2, IX, strName)
            End If
        '-----------------------------------------------------------------------
        ' 2月
        Case 2
            ' 建国記念の日(2/11)
            Call GP_GetHolidaySub2(DateSerial(intY, intM, 11), IX, "建国記念の日")
        '-----------------------------------------------------------------------
        ' 3月
        Case 3
            ' 春分の日(※専用処理)
            Call GP_GetSyunbun(intY, IX)
        '-----------------------------------------------------------------------
        ' 4月
        Case 4
            ' みどりの日(4/29) ⇒ 昭和の日(2007年～)
            If intY >= 2007 Then
                strName = "昭和の日"
            Else
                strName = "みどりの日"
            End If
            Call GP_GetHolidaySub2(DateSerial(intY, intM, 29), IX, strName)
        '-----------------------------------------------------------------------
        ' 5月
        Case 5
            strName = "憲法記念日"
            strName2 = "子供の日"
            If intY >= 1985 Then
                IX = IX + 3
                ReDim Preserve g_tblSyuku(IX)
                ' 憲法記念日(5/3)
                g_tblSyuku(IX - 2).dteDate = DateSerial(intY, intM, 3)
                g_tblSyuku(IX - 2).strName = strName
                ' 国民の休日(5/4)⇒みどりの日(2007年～)
                g_tblSyuku(IX - 1).dteDate = DateSerial(intY, intM, 4)
                If intY >= 2007 Then
                    g_tblSyuku(IX - 1).strName = "みどりの日"
                Else
                    g_tblSyuku(IX - 1).strName = g_cnsKYU2
                End If
                ' 子供の日(5/5)
                If intY < 2007 Then
                    IX = IX - 1     ' 一旦減算(下位Procで加算されるため)
                    Call GP_GetHolidaySub2(DateSerial(intY, intM, 5), IX, strName2)
                Else
                    g_tblSyuku(IX).dteDate = DateSerial(intY, intM, 5)
                    g_tblSyuku(IX).strName = strName2
                    ' 2007年以降は5/3,5/4が日曜の場合も、5/6が振り返られる
                    If ((Weekday(g_tblSyuku(IX - 2).dteDate, vbSunday) = vbSunday) Or _
                        (Weekday(g_tblSyuku(IX - 1).dteDate, vbSunday) = vbSunday) Or _
                        (Weekday(g_tblSyuku(IX).dteDate, vbSunday) = vbSunday)) Then
                        IX = IX + 1
                        ReDim Preserve g_tblSyuku(IX)
                        g_tblSyuku(IX).dteDate = DateSerial(intY, intM, 6)
                        g_tblSyuku(IX).intFuri = 1
                        g_tblSyuku(IX).strName = g_cnsFURI
                    End If
                End If
            Else
                ' 憲法記念日(5/3)
                Call GP_GetHolidaySub2(DateSerial(intY, intM, 3), IX, strName)
                ' 子供の日(5/5)
                Call GP_GetHolidaySub2(DateSerial(intY, intM, 5), IX, strName2)
            End If
        '-----------------------------------------------------------------------
        ' 6月
        Case 6
            ' 祝日なし
        '-----------------------------------------------------------------------
        ' 7月
        Case 7
            If intY >= 1996 Then
                strName = "海の日"
                If intY >= 2003 Then
                    ' 海の日(第3月曜日)
                    Call GP_GetHolidaySub3(intY, intM, 3, 2, IX, strName)
                Else
                    ' 海の日(7/20)
                    Call GP_GetHolidaySub2(DateSerial(intY, intM, 20), IX, strName)
                End If
            End If
        '-----------------------------------------------------------------------
        ' 8月
        Case 8
            ' 祝日なし
        '-----------------------------------------------------------------------
        ' 9月
        Case 9
            strName = "敬老の日"
            If intY >= 2003 Then
                ' 敬老の日(第3月曜日)
                Call GP_GetHolidaySub3(intY, intM, 3, 2, IX, strName)
            Else
                ' 敬老の日(9/15)
                Call GP_GetHolidaySub2(DateSerial(intY, intM, 15), IX, strName)
            End If
            ' 秋分の日(※専用処理)
            Call GP_GetSyuubun(intY, IX)
        '-----------------------------------------------------------------------
        ' 10月
        Case 10
            strName = "体育の日"
            If intY >= 2000 Then
                ' 体育の日(第2月曜日)
                Call GP_GetHolidaySub3(intY, intM, 2, 2, IX, strName)
            Else
                ' 体育の日(10/10)
                Call GP_GetHolidaySub2(DateSerial(intY, intM, 10), IX, strName)
            End If
        '-----------------------------------------------------------------------
        ' 11月
        Case 11
            ' 文化の日(11/3)
            Call GP_GetHolidaySub2(DateSerial(intY, intM, 3), IX, "文化の日")
            ' 勤労感謝の日(11/23)
            Call GP_GetHolidaySub2(DateSerial(intY, intM, 23), IX, "勤労感謝の日")
        '-----------------------------------------------------------------------
        ' 12月
        Case 12
            If intY >= 1989 Then
                ' 天皇誕生日(12/23)
                Call GP_GetHolidaySub2(DateSerial(intY, intM, 23), IX, "天皇誕生日")
            End If
    End Select
End Sub

'*******************************************************************************
' 当該祝日が日曜なら翌日を振替休日にしてテーブルセット(共通Sub処理)
'
' 戻り値：(なし)
' 引数　：Arg1=祝日日付(Date)
' 　　　　Arg2=テーブル最終位置(Long)  ※直前項目の登録位置
' 　　　　Arg3=祝日の名称(String)
'*******************************************************************************
Private Sub GP_GetHolidaySub2(dteHoliday As Date, _
                              IX As Long, _
                              strName As String)
    ' 当該祝日
    IX = IX + 1
    ReDim Preserve g_tblSyuku(IX)
    g_tblSyuku(IX).dteDate = dteHoliday
    g_tblSyuku(IX).strName = strName
    If Weekday(dteHoliday, vbSunday) = vbSunday Then
        ' 日曜と重なった場合の翌日を振替休日とする
        IX = IX + 1
        ReDim Preserve g_tblSyuku(IX)
        g_tblSyuku(IX).dteDate = dteHoliday + 1
        g_tblSyuku(IX).intFuri = 1          ' 振替休日
        g_tblSyuku(IX).strName = g_cnsFURI
    End If
End Sub

'*******************************************************************************
' 年月第n週のm曜日を算出してテーブルセット(共通Sub処理)
'
' 戻り値：(なし)
' 引数　：Arg1=年(Integer)
' 　　　　Arg2=月(Integer)
' 　　　　Arg3=週(Integer)
' 　　　　Arg4=曜日コード(Integer)     ※1=日曜, 2=月曜．．．7=土曜(2のみ利用)
' 　　　　Arg5=テーブル最終位置(Long)  ※直前項目の登録位置
' 　　　　Arg6=祝日の名称(String)
'*******************************************************************************
Private Sub GP_GetHolidaySub3(intY As Integer, _
                              intM As Integer, _
                              intW As Integer, _
                              intG As Integer, _
                              IX As Long, _
                              strName As String)
    Dim dteDate As Date
    Dim intG2 As Integer
    
    IX = IX + 1
    ReDim Preserve g_tblSyuku(IX)
    dteDate = DateSerial(intY, intM, 1)     ' 月初日
    intG2 = Weekday(dteDate, vbSunday)      ' 月初日の曜日
    If intG2 > intG Then intW = intW + 1    ' 初週調整
    g_tblSyuku(IX).dteDate = dteDate - intG2 + (intW - 1) * 7 + intG
    g_tblSyuku(IX).strName = strName
End Sub

'*******************************************************************************
' 春分の日の算出(簡易計算方式)
'
' 戻り値：(なし)
' 引数　：Arg1=年(Integer)
' 　　　　Arg2=テーブル最終位置(Long)  ※直前項目の登録位置
'*******************************************************************************
Private Sub GP_GetSyunbun(intY As Integer, _
                          IX As Long)
    Dim intD As Integer, intY2 As Integer
    
    ' 祝日法施行(1947年)以前,2151年以降(簡易計算不可)は無視
'**********2009/03/01DEL↓(不要記述)
'    IX = IX + 1
'    ReDim Preserve g_tblSyuku(IX)
'**********2009/03/01DEL↑
    intY2 = intY - 1980
    Select Case intY
        Case Is <= 1979
            intD = Int(20.8357 + (0.242194 * intY2) - Int(intY2 / 4))
        Case Is <= 2099
            intD = Int(20.8431 + (0.242194 * intY2) - Int(intY2 / 4))
        Case Else
            intD = Int(21.851 + (0.242194 * intY2) - Int(intY2 / 4))
    End Select
    ' 春分の日
    Call GP_GetHolidaySub2(DateSerial(intY, 3, intD), IX, "春分の日")
End Sub

'*******************************************************************************
' 秋分の日の算出(簡易計算方式)
'
' 戻り値：(なし)
' 引数　：Arg1=年(Integer)
' 　　　　Arg2=テーブル最終位置(Long)  ※直前項目の登録位置
'*******************************************************************************
Private Sub GP_GetSyuubun(intY As Integer, _
                          IX As Long)
    Dim intD As Integer, intY2 As Integer, dteDate As Date
    
    ' 祝日法施行(1947年)以前,2151年以降(簡易計算不可)は無視
    intY2 = intY - 1980
    Select Case intY
        Case Is <= 1979
            intD = Int(23.2588 + (0.242194 * intY2) - Int(intY2 / 4))
        Case Is <= 2099
            intD = Int(23.2488 + (0.242194 * intY2) - Int(intY2 / 4))
        Case Else
            intD = Int(24.2488 + (0.242194 * intY2) - Int(intY2 / 4))
    End Select
    dteDate = DateSerial(intY, 9, intD)
    ' 2003年以降は敬老の日の翌々日が秋分の日の場合､間の日は｢国民の休日｣になる
    If ((intY >= 2003) And ((dteDate - g_tblSyuku(IX).dteDate) = 2)) Then
        IX = IX + 1
        ReDim Preserve g_tblSyuku(IX)
        g_tblSyuku(IX).dteDate = dteDate - 1
        g_tblSyuku(IX).strName = g_cnsKYU2
    End If
    ' 秋分の日
    Call GP_GetHolidaySub2(dteDate, IX, "秋分の日")
End Sub

'--------------------------------<< End of Source >>----------------------------


Attribute VB_Name = "MOD_CALENDAR3"
'*******************************************************************************
'   カレンダーフォーム3(日付入力部品)   ※呼び出しプロシージャ
'*******************************************************************************
' 修正     修正内容------------------------------------------------------------>
' 09/02/15 ShowCalendarFromRange2に結合セル対応を追加
'*******************************************************************************
Option Explicit
Public Const cnsDateFormat = "YYYY/MM/DD"   ' デフォルトの日付Format
Private Const cnsCaption = "日付選択"       ' デフォルトのCaption
Public g_swCalendar1Loaded As Boolean       ' Load判定スイッチ

'*******************************************************************************
' ユーザーフォームのテキストボックス(MsForms.TextBox)から表示させる
'*******************************************************************************
' [引数]
' 　・テキストボックス(Object、シートからの場合はコントロールツールボックスの物)
' 　・カレンダーフォームのCaption(String) ※Option、デフォルトは"日付選択"
' 　・値を返す時のFormat(String) ※Option、デフォルトは"YYYY/MM/DD"
' 　・カレンダーフォームの表示位置：横(Long) ※Option
' 　・カレンダーフォームの表示位置：縦(Long) ※Option
'*******************************************************************************
Public Sub ShowCalendarFromTextBox2(objTextBox As MSForms.TextBox, _
                                    Optional strCaption As String, _
                                    Optional strFormat As String, _
                                    Optional lngLeft As Long, _
                                    Optional lngTop As Long)
    Dim dteDate As Date
    
    ' 元となる日付をテキストボックスから取得
    If IsDate(Trim(objTextBox.Text)) Then
        dteDate = CDate(Trim(objTextBox.Text))
    End If
    ' Caption(タイトル)指定がない場合はデフォルト("日付選択")を指定
    If strCaption = "" Then strCaption = cnsCaption
    ' 表示フォーマット指定がない場合はデフォルト("YYYY/MM/DD")を指定
    If strFormat = "" Then strFormat = cnsDateFormat
    ' カレンダーフォーム
    With FRM_CALENDAR3
        ' Tagに元日付(シリアル値)をセット
        .Tag = CLng(dteDate)
        ' Captionをセット
        .Caption = strCaption
        ' フォーム表示位置の確認
        If ((lngLeft <> 0) And (lngTop <> 0)) Then
            ' 指定がある場合はマニュアル指定
            .StartUpPosition = 0
            .Left = lngLeft
            .Top = lngTop
        Else
            ' 指定がない場合はオーナーフォームの中央
            .StartUpPosition = 1
        End If
        ' カレンダーフォームを表示
        .Show
        ' フォームがUnloadされた場合は以降の処理を無視する
        On Error Resume Next
        ' Tagの日付を確認
        If IsNumeric(.Tag) <> True Then Exit Sub
        If Err.Number <> 0 Then Exit Sub
        On Error GoTo 0
        ' Tagから選択日付を取り出してテキストボックスにセット
        dteDate = CDate(.Tag)
        objTextBox.Text = Format(dteDate, strFormat)
    End With
End Sub

'*******************************************************************************
' セル(Range)から表示させる
'*******************************************************************************
' [引数]
' 　・セル(Object) ※原則として単一セル
' 　・カレンダーフォームのCaption(String) ※Option、デフォルトは"日付選択"
' 　・カレンダーフォームの表示位置：横(Long) ※Option
' 　・カレンダーフォームの表示位置：縦(Long) ※Option
'*******************************************************************************
Public Sub ShowCalendarFromRange2(objRange As Range, _
                                  Optional strCaption As String, _
                                  Optional lngLeft As Long, _
                                  Optional lngTop As Long)
    Dim dteDate As Date

    ' 元となる日付をセルから取得
'**********2009/02/15UPD↓(結合セル対応)
'    If IsDate(Trim(objRange.Value)) Then
'        dteDate = CDate(Trim(objRange.Value))
    If IsDate(Trim(objRange.Cells(1).Value)) Then
        dteDate = CDate(Trim(objRange.Cells(1).Value))
'**********2009/02/15UPD↑
    End If
    ' Caption(タイトル)指定がない場合はデフォルト("日付選択")を指定
    If strCaption = "" Then strCaption = cnsCaption
    ' カレンダーフォーム
    With FRM_CALENDAR3
        ' Tagに元日付(シリアル値)をセット
        .Tag = CLng(dteDate)
        ' Captionをセット
        .Caption = strCaption
        ' フォーム表示位置の確認
        If ((lngLeft <> 0) And (lngTop <> 0)) Then
            ' 指定がある場合はマニュアル指定
            .StartUpPosition = 0
            .Left = lngLeft
            .Top = lngTop
        Else
            ' 指定がない場合はオーナーフォームの中央
            .StartUpPosition = 1
        End If
        ' カレンダーフォームを表示
        .Show
        ' フォームがUnloadされた場合は以降の処理を無視する
        On Error Resume Next
        ' Tagの日付を確認
        If IsNumeric(.Tag) <> True Then Exit Sub
        If Err.Number <> 0 Then Exit Sub
        On Error GoTo 0
        ' Tagから選択日付を取り出してセルにセット
        dteDate = CDate(.Tag)
'**********2009/02/15UPD↓(結合セル対応)
'        objRange.Value = dteDate
        objRange.Cells(1).Value = dteDate
'**********2009/02/15UPD↑
    End With
End Sub

'--------------------------------<< End of Source >>----------------------------




Attribute VB_Name = "給与追加"
Attribute VB_Base = "0{1D9377C2-D7B7-4F46-BDD1-7B5C4E5910BD}{2DB2C6FA-6436-4B6D-8BE9-FCB9BF5E4E5A}"
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 Sh As String
Private Sub CommandButton1_Click()
    Dim i As Long
    Dim n As Long
    Dim Gyo As Long
    n = 0
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            n = n + 1
        End If
    Next
    If n = 0 Then
        MsgBox "リストを選択してください。", 16, "エラー"
        Exit Sub
    End If
    With Workbooks(tn).Worksheets(シート)
        Gyo = .Cells(10000, 2).End(xlUp).Row + 1 '末尾の行
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                n = Val(ListBox1.List(i, 0)) '給与入力の行番号
                .Range("B" & Gyo & ":DE" & Gyo).Value = Workbooks(tn).Worksheets(Sh).Range("B" & n & ":DE" & n).Value
                .Range("F" & Gyo & ":CV" & Gyo).ClearContents
                追加F.ListBox1.AddItem ListBox1.List(i, 1)
                Gyo = Gyo + 1
            End If
        Next
    End With
    
    Unload Me
End Sub

Private Sub UserForm_Activate()
    Dim i As Long
    Dim n As Long
    tn = Worksheets("DATA1").Cells(1, 1).Value
    If シート Like "賞*" Or シート Like "月*" Then '20111214　重　保存データは給与入力とする
        Sh = "給与入力"
        Label1.Caption = "左の社員は給与データに登録されている社員のうち､現在データに登録されていない社員リストです｡この中から社員を選択して追加してください｡"
        Else
        Sh = "賞与入力"
        Label1.Caption = "左の社員は賞与データに登録されている社員のうち､現在の給与に登録されていない社員リストです｡この中から社員を選択して追加してください｡"
    End If
    Me.Caption = Left(Sh, 2) & "データからの追加"
    
    n = 0
    With Workbooks(tn).Worksheets(Sh)
        For i = 8 To .Cells(10000, 5).End(xlUp).Row
            '賞与にそのNoがなかったら
            If IsError(Application.Match(.Cells(i, 2).Value, Workbooks(tn).Worksheets(シート).Range("B8:B5000"), 0)) = True Then
                ListBox1.AddItem i
                ListBox1.List(n, 1) = Format(.Cells(i, 2).Value, "000000") & "  " & .Cells(i, 5).Value
                n = n + 1
            End If
        Next
    End With
    If ListBox1.ListCount = 0 Then
        Label4.Visible = True
    End If
End Sub

Attribute VB_Name = "基本情報"
Attribute VB_Base = "0{8A9E65AD-595D-43A5-BBD1-193F49064047}{50C46110-2796-4688-8F2B-074AACA1CB26}"
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()
基本F.Show
End Sub
Private Sub CommandButton2_Click()
項目F.Show
End Sub

Private Sub CommandButton3_Click()
計算F.Show

End Sub


Attribute VB_Name = "項目F"
Attribute VB_Base = "0{CEE73A5A-B3AE-4B6A-9785-812F55DB6ED4}{F3ADF054-1B94-43C7-B620-44BF76BB210C}"
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 手当選択(手当 As Integer)
    Dim n As Long
    Dim i As Long
    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
    With Workbooks(tn).Worksheets("給与入力")
        For n = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(n) = True Then
                .Cells(手当, 42 + n).Value = IIf(Controls("CheckBox" & 手当).Value = True, True, "")
                ListBox1.List(n, 手当) = IIf(Controls("CheckBox" & 手当).Value = True, "○", "")
            End If
        Next
    End With
End Sub
Private Sub CheckBox1_Click()
    Call 手当選択(1)
End Sub

Private Sub CheckBox3_Click()
    Call 手当選択(3)
End Sub
Private Sub CheckBox4_Click()
    Call 手当選択(4)
End Sub
Private Sub CheckBox5_Click()
    Call 手当選択(5)
End Sub
Private Sub 控除選択(控除 As Integer)
    Dim n As Long
    Dim i As Long
    n = 0
    For i = 0 To ListBox3.ListCount - 1
        If ListBox3.Selected(i) = True Then
            n = 1
            Exit For
        End If
    Next
    If n = 0 Then
        MsgBox "リストを選択してから実行してください。", 16, "リスト"
        Exit Sub
    End If
    If 控除 = 2 Then
    i = 1
    Else
    i = 2
    End If
    With Workbooks(tn).Worksheets("賞与入力")
        For n = 0 To ListBox3.ListCount - 1
            If ListBox3.Selected(n) = True Then
                .Cells(控除, 42 + n).Value = IIf(Controls("Check" & 控除).Value = True, True, "")
                ListBox3.List(n, i) = IIf(Controls("Check" & 控除).Value = True, "○", "")
            End If
        Next
    End With
End Sub
Private Sub Check5_Click()
    Call 控除選択(5)
End Sub
Private Sub CheckBox43_Click()
    Dim n As Long
    Dim i As Long
    n = 0
    For i = 0 To ListBox2.ListCount - 1
        If ListBox2.Selected(i) = True Then
            n = 1
            Exit For
        End If
    Next
    If n = 0 Then
        MsgBox "リストを選択してから実行してください。", 16, "リスト"
        Exit Sub
    End If
    With Workbooks(tn).Worksheets("給与入力")
        For n = 0 To ListBox2.ListCount - 1
            If ListBox2.Selected(n) = True Then
                .Cells(3, 76 + n).Value = IIf(CheckBox43.Value = True, True, "")
                ListBox2.List(n, 1) = IIf(CheckBox43.Value = True, "○", "")
            End If
        Next
    End With

End Sub

Private Sub CommandButton4_Click()
    Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(i) = False
    Next
    Label203.Caption = ""
    Label204.Caption = ""
End Sub

Private Sub CommandButton5_Click()
    Dim i As Long
    For i = 0 To ListBox2.ListCount - 1
        ListBox2.Selected(i) = False
    Next
    Label214.Caption = ""
    Label216.Caption = ""

End Sub

Private Sub CommandButton6_Click()
    Dim i As Long
    For i = 0 To ListBox3.ListCount - 1
        ListBox3.Selected(i) = False
    Next
    Label220.Caption = ""
    Label222.Caption = ""

End Sub

Private Sub CommandButton7_Click()
    Dim n As Long
    Dim i As Long
    Dim 印 As String
    If OptionButton1.Value = True Then
        印 = "○"
        Else
        印 = ""
    End If
    n = 0
    For i = 0 To ListBox4.ListCount - 1
        If ListBox4.Selected(i) = True Then
            If ListBox4.List(i, 1) = "***" Then
                ListBox4.Selected(i) = False
                Else
                n = 1
            End If
        End If
    Next
    If n = 0 Then
        MsgBox "リストを選択してから実行してください。", 16, "リスト"
        Exit Sub
    End If
    With Workbooks(tn).Worksheets("基本情報")
        For n = 0 To ListBox4.ListCount - 1
            If ListBox4.Selected(n) = True Then
                .Cells(141 + n, 1).Value = 印
                ListBox4.List(n, 1) = 印
            End If
        Next
    End With
    For i = 0 To ListBox4.ListCount - 1
        ListBox4.Selected(i) = False
    Next
    MsgBox "ＯＫ", 64, "賃金ファイル"

End Sub

Private Sub CommandButton8_Click()
対象外手当.Show
End Sub

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim n As Long
    n = ListBox1.ListIndex + 2
    Label203.Caption = Controls("Label" & n).Caption
    Label204.Caption = Controls("TextBox" & n).Value
End Sub

Private Sub ListBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim n As Long
    n = ListBox2.ListIndex
    Label214.Caption = Controls("Label" & n + 36).Caption
    Label216.Caption = Controls("TextBox" & n + 36).Value
End Sub
Private Sub ListBox3_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim n As Long
    n = ListBox3.ListIndex
    Label220.Caption = Controls("Lab" & n + 42).Caption
    Label222.Caption = Controls("Text" & n + 42).Value
End Sub

Private Sub UserForm_Activate()
    
    Dim i As Long
    Dim j As Long
    Dim k As Long

    j = 1
    k = 1
 
    With Workbooks(tn).Worksheets("給与入力")
        For i = 6 To 18 '勤怠
            Controls("TextBox" & (i + 49)).ControlSource = .Cells(7, i).Address(, , , True)

        Next
        For i = 41 To 93 '手当控除
            If i = 41 Or (i >= 64 And i <= 75) Or i = 92 Or i = 93 Then
            Else
                If i < 64 Then
                    Controls("Label" & (i - 40)).Caption = "手当" & j
                    j = j + 1
                    Else
                    Controls("Label" & (i - 40)).Caption = "控除" & k
                    k = k + 1
                End If
            End If
            Controls("TextBox" & (i - 40)).ControlSource = .Cells(7, i).Address(, , , True)
            ListBox4.AddItem IIf(.Cells(7, i).Value = 0, "未登録", .Cells(7, i).Value) '強調表示項目
            If ListBox4.List(i - 41, 0) = "未登録" Then
                ListBox4.List(i - 41, 1) = "***"
                Else
                ListBox4.List(i - 41, 1) = Workbooks(tn).Worksheets("基本情報").Cells(100 + i, 1).Value
            End If
        Next
        For i = 2 To 23
            ListBox1.AddItem Controls("Label" & i).Caption
            ListBox1.List(i - 2, 1) = IIf(.Cells(1, 40 + i).Value = True, "○", "")
            ListBox1.List(i - 2, 2) = "" '20120201 労保は使わなくなった
            ListBox1.List(i - 2, 3) = IIf(.Cells(3, 40 + i).Value = True, "○", "")
            ListBox1.List(i - 2, 4) = IIf(.Cells(4, 40 + i).Value = True, "○", "")
            ListBox1.List(i - 2, 5) = IIf(.Cells(5, 40 + i).Value = True, "○", "")
        Next
        For i = 0 To 15
            ListBox2.AddItem Controls("Label" & i + 36).Caption
            ListBox2.List(i, 1) = IIf(.Cells(3, 76 + i).Value = True, "○", "")
        Next
        CheckBox45.ControlSource = .Cells(3, 6).Address(, , , True) '更新時勤怠項目すべてクリア
        
    End With
    With Workbooks(tn).Worksheets("賞与入力")
        On Error Resume Next
        For i = 41 To 93
            Controls("Text" & i).ControlSource = .Cells(7, i).Address(, , , True)
        Next
        On Error GoTo 0
        For i = 42 To 49
            ListBox3.AddItem Controls("Lab" & i).Caption
            ListBox3.List(i - 42, 1) = "" '20120201 労保は使わなくなった
            ListBox3.List(i - 42, 2) = IIf(.Cells(5, i).Value = True, "○", "")
        Next

        Chec41.ControlSource = .Cells(3, 41).Address(, , , True) '更新時賞与項目すべてクリア
    End With
    
    Check60.ControlSource = Workbooks(tn).Worksheets("基本情報").Cells(21, 3).Address(, , , True)
    MultiPage1.Value = 0
End Sub


Attribute VB_Name = "FRM_CALENDAR3"
Attribute VB_Base = "0{1929ABD3-ADC7-42B5-B604-36651B487E16}{344306F8-F9F6-4A6D-A5F5-6A69B195EC34}"
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
'-------------------------------------------------------------------------------
' [起算曜日] ※カレンダーを月曜開始(曜日左端)にする場合は｢2｣に変更して下さい。
Private Const g_cnsStartYobi = 1                ' 1=日曜日,2=月曜日(他は不可)
'-------------------------------------------------------------------------------
' [年の表示限度(From/To)]
Private Const g_cnsYearFrom = 1947              ' 祝日法施行
Private Const g_cnsYearToAdd = 3                ' システム日の年+n年までの指定
'-------------------------------------------------------------------------------
' フォーム上の色指定等の定数
Private Const cnsBC_Select = &HFFCC33           ' 選択日付の背景色
Private Const cnsBC_Other = &HE0E0E0            ' 当月以外の背景色
Private Const cnsBC_Sunday = &HFFDDFF           ' 日曜の背景色
Private Const cnsBC_Saturday = &HDDFFDD         ' 土曜の背景色
Private Const cnsBC_Month = &HFFFFFF            ' 当月土日以外の背景色
Private Const cnsFC_Hori = &HFF                 ' 祝日の文字色
Private Const cnsFC_Normal = &HC00000           ' 祝日以外の文字色
Private Const cnsDefaultGuide = "矢印キーで操作できます。"
'-------------------------------------------------------------------------------
' フォーム表示中に保持するモジュール変数
Private tblDate(1 To 45) As MSForms.Label       ' 日付ラベル
Private tblDate2(1 To 45) As Date               ' 日付
Private tblYobi(1 To 45) As Integer             ' 曜日
Private tblGuide(1 To 45) As String             ' ガイド
Private g_intCurYear As Integer                 ' 現在表示年
Private g_intCurMonth As Integer                ' 現在表示月
Private g_FormDate1 As Date                     ' 現在日付
Private g_CurPos As Integer                     ' 現在日付位置
Private g_POS_F As Integer                      ' 月初日位置
Private g_POS_T As Integer                      ' 月末日位置
Private g_swBatch As Boolean                    ' イベント抑制SW
Private g_VisibleYear As Boolean                ' Conboの年表示スイッチ
Private g_VisibleMonth As Boolean               ' Comboの月表示スイッチ
Private g_intSunday As Integer                  ' 日曜日の曜日コード
Private g_intSaturday As Integer                ' 土曜日の曜日コード

'*******************************************************************************
' ■フォーム上のイベント
'*******************************************************************************
' ｢月｣コンボの操作イベント
'*******************************************************************************
Private Sub CBO_MONTH_Change()
    Dim intMonth As Integer

    If g_swBatch Then Exit Sub
    intMonth = CInt(CBO_MONTH.Text)
    g_FormDate1 = DateSerial(g_intCurYear, intMonth, 1)
    Call ERASE_YEAR_MONTH                       ' 年月コンボの非表示化
    ' カレンダー作成
    Call GP_MakeCalendar
End Sub

'*******************************************************************************
' ｢年｣コンボの操作イベント
'*******************************************************************************
Private Sub CBO_YEAR_Change()
    Dim intYear As Integer
    
    If g_swBatch Then Exit Sub
    intYear = CInt(CBO_YEAR.Text)
    g_FormDate1 = DateSerial(intYear, g_intCurMonth, 1)
    Call ERASE_YEAR_MONTH                       ' 年月コンボの非表示化
    ' カレンダー作成
    Call GP_MakeCalendar
End Sub

'*******************************************************************************
' 各日付ラベルのイベント(クラス処理はしないでそれぞれClickイベント等で受ける)
'*******************************************************************************
' 各日付ラベル(7曜×6週=42件、対応日付は表示時点で配列化されている)
Private Sub LBL_01_Click(): Call GP_ClickCalendar(tblDate2(1)):  End Sub
Private Sub LBL_02_Click(): Call GP_ClickCalendar(tblDate2(2)):  End Sub
Private Sub LBL_03_Click(): Call GP_ClickCalendar(tblDate2(3)):  End Sub
Private Sub LBL_04_Click(): Call GP_ClickCalendar(tblDate2(4)):  End Sub
Private Sub LBL_05_Click(): Call GP_ClickCalendar(tblDate2(5)):  End Sub
Private Sub LBL_06_Click(): Call GP_ClickCalendar(tblDate2(6)):  End Sub
Private Sub LBL_07_Click(): Call GP_ClickCalendar(tblDate2(7)):  End Sub
Private Sub LBL_08_Click(): Call GP_ClickCalendar(tblDate2(8)):  End Sub
Private Sub LBL_09_Click(): Call GP_ClickCalendar(tblDate2(9)):  End Sub
Private Sub LBL_10_Click(): Call GP_ClickCalendar(tblDate2(10)): End Sub
Private Sub LBL_11_Click(): Call GP_ClickCalendar(tblDate2(11)): End Sub
Private Sub LBL_12_Click(): Call GP_ClickCalendar(tblDate2(12)): End Sub
Private Sub LBL_13_Click(): Call GP_ClickCalendar(tblDate2(13)): End Sub
Private Sub LBL_14_Click(): Call GP_ClickCalendar(tblDate2(14)): End Sub
Private Sub LBL_15_Click(): Call GP_ClickCalendar(tblDate2(15)): End Sub
Private Sub LBL_16_Click(): Call GP_ClickCalendar(tblDate2(16)): End Sub
Private Sub LBL_17_Click(): Call GP_ClickCalendar(tblDate2(17)): End Sub
Private Sub LBL_18_Click(): Call GP_ClickCalendar(tblDate2(18)): End Sub
Private Sub LBL_19_Click(): Call GP_ClickCalendar(tblDate2(19)): End Sub
Private Sub LBL_20_Click(): Call GP_ClickCalendar(tblDate2(20)): End Sub
Private Sub LBL_21_Click(): Call GP_ClickCalendar(tblDate2(21)): End Sub
…