Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    MsgBox "このファイルは保存できません。", 16, "保存不可"
    Cancel = True
End Sub




Attribute VB_Name = "退職金2"
Attribute VB_Base = "0{AFFBAEA1-43D5-4245-B5D6-8F325415F506}{1216FF49-3E7F-4EA3-A80D-B15A65535531}"
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 T2 As Worksheet
Dim T As Worksheet
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton3_Click()
Sheets("退職金").Select
Unload Me
End Sub

Private Sub CommandButton2_Click()
Set T2 = Worksheets("退職金")
T2.Range(T2.Cells(20, 17), T2.Cells(22, 20)).Value = T.Range(T.Cells(52, 6), T.Cells(54, 9)).Value
T2.Cells(26, 5).Value = T.Cells(60, 9).Value '退職金額
T2.Cells(11, 9).Value = T.Cells(64, 6).Value '会社名
T2.Cells(11, 3).Value = T.Cells(62, 6).Value '退職者名

Unload Me
入力.Show

End Sub

Private Sub UserForm_Initialize()
Set T = Worksheets("MENU")
Label1.Caption = T.Cells(62, 6).Value
TextBox1.Value = T.Cells(60, 6).Text

TextBox2.Value = T.Cells(56, 11).Text
TextBox8.Value = T.Cells(57, 11).Text
TextBox3.Value = T.Cells(58, 5).Text
TextBox4.Value = T.Cells(58, 9).Text

TextBox7.Value = T.Cells(60, 9).Text


End Sub

Attribute VB_Name = "Sheet21"
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



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 = "Sheet211"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True






















Attribute VB_Name = "Module1"
'***修正履歴
'源泉所得税を100円未満切捨てに変更V2.11　　20071105 kon
Option Explicit
'20071001 kon add
Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
    Const SW_SHOWNORMAL = 1
    Const SE_ERR_NOASSOC = 31
    Const ERROR_FILE_NOT_FOUND = 2&
Sub 申告書()
    Call pdf("退職所得の受給に関する申告書")
End Sub
Sub 徴収票()
    Call pdf("退職所得の源泉徴収票")
End Sub
Sub マニュアル()
Call pdf("退職金計算")
End Sub
Sub pdf(n As String)
    Dim strPath     As String
    Dim lngRet      As Long

    strPath = ThisWorkbook.Path & "\退職金計算\" & n & ".pdf"
    lngRet = ShellExecute(0, "Open", strPath & vbNullString, _
                vbNullString, vbNullString, SW_SHOWNORMAL)
End Sub
Sub 入力へ()
入力.Show
End Sub
Sub 退職金の計算へ()
退職金の計算.Show
End Sub

Sub A保存()
KURIA
    Application.EnableEvents = False
    ThisWorkbook.Save
    Application.EnableEvents = True
End Sub
Sub KURIA()
    Sheets("MENU").Select

End Sub

Sub Da保存2へ()
    Dim MyName As String
    If Worksheets("MENU").Cells(1, 1).Value = 1 Then
    Da保存.Show
    
    Exit Sub
    End If
    MyName = Cells(11, 3).Value & " 作成日" & Format(Date, "geemmdd")
    Open Workbooks("DaMenu.xls").Path & "\HozonName.dat" For Output As #1
        Write #1, MyName
    Close #1
    Application.Run "DaAddin.xla!Da保存へ"

End Sub
Sub Da保存読込2へ()
    If Worksheets("MENU").Cells(1, 1).Value = 1 Then
    Da保存読込.Show
    
    Exit Sub
    End If

    
    Application.Run "DaAddin.xla!Da保存読込へ"
End Sub
Sub OpenManual()
Application.Run "DaAddin.xla!OpenManual"
End Sub
Sub 支給率保存へ()
Da保存.Show
End Sub
Sub 支給率読込へ()
    Da保存読込.Show
End Sub


'/* 年齢計算関数(fncNenrei) */
'
'　Tanjyobi := 誕生日(ge/m/d形式又はy/m/d)
'  Kijyunbi := 基準日(y/m/d)
'  戻り値 := 文字列(整数部は年齢で小数部は月数）

Function fncNenrei(ByVal Tanjyobi As Variant, ByVal Kijyunbi As Variant) As Variant
Dim nOld As Integer         ''年齢(年)
Dim nTuki As Integer        ''　　(月)
    
    If IsDate(Tanjyobi) = False Then
        fncNenrei = "#Error"
        Exit Function
    Else
        Tanjyobi = CVDate(Tanjyobi)  'gee/mm/dd => yyyy/mm/dd
    End If
    If IsDate(Kijyunbi) = False Then
        fncNenrei = "#Error"
        Exit Function
    Else
        Kijyunbi = CVDate(Kijyunbi)
    End If
    Kijyunbi = Kijyunbi + 1
    If Kijyunbi < Tanjyobi Then
        fncNenrei = "#Error"
        Exit Function
    End If
    
    '年齢(？歳？カ月)を計算する
    If Kijyunbi = Tanjyobi Then
        nOld = 0
        nTuki = 0
    ElseIf Year(Kijyunbi) <> Year(Tanjyobi) Then
        'DateDiff関数を用いて数え歳-1を求める
        nOld = DateDiff("yyyy", Tanjyobi, Kijyunbi) - 1
        nTuki = Month(Kijyunbi) - Month(Tanjyobi) + 11
        If Day(Kijyunbi) >= Day(Tanjyobi) Then
            nTuki = nTuki + 1
        End If
        If nTuki >= 12 Then
            nOld = nOld + 1
            nTuki = nTuki - 12
        End If
    Else
        nOld = 0
        If Month(Kijyunbi) = Month(Tanjyobi) Then
            nTuki = 0
        ElseIf Month(Kijyunbi) >= Month(Tanjyobi) Then
            If Day(Kijyunbi) >= Day(Tanjyobi) Then
                nTuki = Month(Kijyunbi) - Month(Tanjyobi)
            Else
                nTuki = Month(Kijyunbi) - Month(Tanjyobi) - 1
            End If
        End If
    End If
    '戻り値のセット
    fncNenrei = Format$(CDec(nOld + nTuki * 0.01), "0.00")

End Function



Attribute VB_Name = "シート"
Attribute VB_Base = "0{5862F751-BDBB-4C22-B13F-2AEEDF25912F}{C477053E-2C0F-43AE-B6E4-E506A0CDB5F0}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False















Private Sub CommandButton1_Click()
If ListBox1.ListIndex = -1 Then
MsgBox "シートが選択されていません"
Else
Sheets(ListBox1.Value).Select
Unload Me
End If
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim S As Worksheet
  For Each S In Worksheets
    With S
      ListBox1.AddItem S.Name
    End With
Next
End Sub

Attribute VB_Name = "画面調整"
Attribute VB_Base = "0{F6426F67-39BF-46CD-9EE5-1C7AFAD4426F}{562D01DC-AB14-40E4-A99F-02393BA92410}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False




































Private Sub CommandOK_Click()
Dim S As Worksheet
Dim n As Integer
Application.ScreenUpdating = False
 If OptionButton1.Value = True Then
   n = 75
  ElseIf OptionButton2.Value = True Then
   n = 100
  ElseIf OptionButton3.Value = True Then
   n = 125
  Else
  n = ActiveWindow.Zoom
 End If
For Each S In Worksheets
    With S
      .Activate
      ActiveWindow.Zoom = n
       ActiveWindow.DisplayHeadings = False
    End With
Next
Sheets("MENU").Select
Unload Me
End Sub
Private Sub Commandキャンセル_Click()
Unload Me
End Sub
  

Attribute VB_Name = "Module11"
Dim MSG As Integer
Sub 印刷()
Application.ScreenUpdating = False
MSG = MsgBox("プリンタの準備はいいですか？", 1 + 32, "印刷")
 If MSG = 1 Then
ActiveSheet.PrintOut
End If
End Sub
Sub 画面調整フォームへ()
画面調整.Show
End Sub
Sub MENUへ()
Sheets("MENU").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Cells(5, 4).Select
End Sub
Sub 退職金へ()
Sheets("退職金").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
End Sub
Sub 税額表へ()
Sheets("TABLE").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
End Sub
Sub 支給率表へ()
Sheets("支給率").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
End Sub
Sub 取り説へ()
Sheets("取り説").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
End Sub
Sub 初期処理()
スクロール範囲限定とシートの保護と画面調整
Cells(1, 1).Value = ""
End Sub
Sub Auto_Open()
スクロール範囲限定とシートの保護と画面調整
Cells(1, 1).Value = 1 '単体版
 End Sub
Private Sub スクロール範囲限定とシートの保護と画面調整()
  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").ScrollArea = "A1"

ActiveWindow.DisplayWorkbookTabs = False
MENUへ
End Sub
Sub スクロール範囲限定解除()
Attribute スクロール範囲限定解除.VB_ProcData.VB_Invoke_Func = "A\n14"
ActiveSheet.ScrollArea = ""
End Sub
Sub 保護の解除()
ActiveSheet.Unprotect
MsgBox "保護を解除しました"
End Sub
Sub 保存終了()
     Application.DisplayAlerts = (False)
     On Error Resume Next
     Dim fila As Integer
     fila = 0
     For Each file_name In Windows
        If file_name.Caption = "台帳ＭＥＮＵ.XLS" Or file_name.Caption = "台帳ＭＥＮＵ.xls" Then
           fila = 1
    End If
    Next '台帳版は1 単独版は0
   
     MSG = MsgBox("お疲れさまでした。「退職金計算」を保存して終了しますか？" & Chr(13) & Chr(13) & _
      "保存して終了は  　<は い  (Y)>)" & Chr(13) & _
      "保存せずに終了は　<いいえ(N)>)" & Chr(13) & _
      "終了しないは    　　<キャンセル>", 3 + 48, "「退職金計算」の終了")
    Application.ScreenUpdating = False
          If MSG = 6 Then
               ActiveWorkbook.Save
                If fila = 0 Then '台帳版はClose 単独版はQuit
                Application.Quit
                Else
                Application.Run "DaAddin.xla!閉じる"

                End If
          ElseIf MSG = 7 Then
                If fila = 0 Then
                Application.Quit
                Else
                Application.Run "DaAddin.xla!閉じる"

                End If
        Else
    End If
End Sub
Sub 終了()
     Dim n As Integer, Wb As Workbook
     On Error Resume Next
    
    If MsgBox("終了してもいいですか？", 1 + 32, "終了") <> 1 Then Exit Sub
    n = Workbooks.Count
    For Each Wb In Workbooks
        If StrConv(Wb.Name, vbUpperCase) = "PERSONAL.XLS" Then
            n = n - 1
        End If
    Next
    Application.DisplayAlerts = False
    If n = 1 Then
        Application.Quit
        Else
         '20101108 masa 2010対応
        'ThisWorkbook.Close
        Application.OnTime Now + TimeValue("00:00:01"), "CloseThisWorkbook"
    End If
End Sub
'20101108 masa 2010対応
Sub CloseThisWorkbook()
   ThisWorkbook.Close False
End Sub
Sub 各シートへ()
Attribute 各シートへ.VB_ProcData.VB_Invoke_Func = "S\n14"
シート.Show
End Sub



Attribute VB_Name = "Da保存読込"
Attribute VB_Base = "0{0C83D67A-F3BB-4CF3-8556-E785226832EE}{90936478-866F-40C4-911A-71C6EE034B5D}"
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 n As Integer
Dim ファイル名 As String
Dim ファイル区分 As String
Dim MyFile As String
Dim MyCheck As Boolean
Dim Kara As String
Private Sub CommandButton1_Click()
    Dim S As String
    S = ActiveSheet.Name
    If ListBox1.ListIndex = -1 Then
        MsgBox "ファイルが選択されていません", 16, "読込"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Workbooks.Open ActiveWorkbook.Path & "\Da保存\" & ListBox1.Value & ファイル区分
    If S = "退職金" Then '単体版なら
    ThisWorkbook.Worksheets("退職金").Range("C7:I37").Value = Range("C7:I37").Value
    Else
    ThisWorkbook.Worksheets("支給率").Range("D8:F53").Value = Range("D8:F53").Value
    End If
    ActiveWorkbook.Close False
    ThisWorkbook.Activate
    MsgBox "OK", 64, "読込"
    Unload Me
    Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
    If ListBox1.ListIndex = -1 Then
        MsgBox "ファイルが選択されていません", 16, "読込"
        Exit Sub
    End If
    If MsgBox(ListBox1.Value & "を削除してもいいですか？", 1 + 32, "削除") <> 1 Then Exit Sub
    Kill ActiveWorkbook.Path & "\Da保存\" & ListBox1.Value & ファイル区分
    ListBox1.RemoveItem ListBox1.ListIndex
    MsgBox "削除しました", 64, "読込"
End Sub
Private Sub CommandButton3_Click()
    Dim i As Integer
    If Trim(TextBox1.Value) = "" Then
        MsgBox "検索する文字列を入力して下さい。", 16, "読込"
        Exit Sub
    End If
    Dim n As Integer
    If MyCheck = False Then
        n = 0
        Else
        n = ListBox1.ListIndex + 1 '現在選択されている位置の次のところ
    End If
    For i = n To ListBox1.ListCount - 1
        If ListBox1.List(i, 0) Like "*" & TextBox1.Value & "*" Then
            ListBox1.Selected(i) = True
            MyCheck = True
            Exit Sub
        End If
    Next
    MsgBox "見つかりません。", 64, "読込"

End Sub
Private Sub TextBox1_Change()
    MyCheck = False
End Sub

Private Sub UserForm_Activate()
    Me.Caption = ActiveSheet.Name & "の保存データ読込"
    If Kara = "Zi" Then
    With Worksheets("DATA")
    ファイル区分 = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & " " & Left(.Cells(1, 1).Value, Len(.Cells(1, 1).Value) - 4) & " " & ActiveSheet.Name & ".xls" '会社名＋様式名
    End With
    Else
    ファイル区分 = Left(MyFile, Len(MyFile) - 4) & " " & ActiveSheet.Name & ".xls" 'ブック名＋シート名で保存する
    End If
    ファイル名 = Dir(ActiveWorkbook.Path & "\Da保存\*" & ファイル区分)
    n = Len(ファイル区分) '書類名以外のファイル名の文字数
    Do While ファイル名 <> ""
        With ListBox1
            .AddItem Left(ファイル名, Len(ファイル名) - n)  '
            ファイル名 = Dir()
        End With
    Loop

End Sub

Private Sub UserForm_Initialize()
    On Error GoTo ErrorC
    MyFile = ActiveWorkbook.Name
    Kara = ""
    If Right(Worksheets("DATA").Cells(1, 1).Value, 6) = "da.xls" Then
        Kara = "Zi"
        End If
    Exit Sub
ErrorC:
End Sub


Attribute VB_Name = "退職金"
Attribute VB_Base = "0{A21C54EE-5FD7-442F-B593-EC7B69A9704F}{4CBB37E2-519A-4BBC-A07B-3DAFCA00A8B6}"
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 T As Worksheet
Private Sub CommandButton1_Click()
Unload Me

End Sub

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim MSG As Integer
      MSG = MsgBox("プリンタの準備はいいですか？", 1 + 32, "印刷")
      If MSG = 1 Then
        Worksheets("退職金").PrintOut
End If

End Sub

Private Sub CommandButton3_Click()
Sheets("退職金").Select
Unload Me
End Sub

Private Sub UserForm_Initialize()
Set T = Worksheets("退職金")
Label1.Caption = T.Cells(11, 3).Value
TextBox1.Value = T.Cells(26, 5).Text
TextBox2.Value = T.Cells(24, 5).Text
TextBox3.Value = T.Cells(28, 5).Text
TextBox4.Value = T.Cells(28, 9).Text
TextBox5.Value = T.Cells(30, 9).Text
TextBox6.Value = T.Cells(32, 5).Text
TextBox7.Value = T.Cells(34, 5).Text
TextBox8.Value = T.Cells(25, 20).Text

End Sub

Attribute VB_Name = "Da保存"
Attribute VB_Base = "0{1C60F979-694E-4860-B721-1529260AF429}{980A1F34-C13D-4119-8BC2-24A683DEC9F2}"
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 Kara As String


Private Sub CommandButton1_Click()
    Dim 保存ファイル名 As String
    Dim ファイル区分 As String
    Dim MyFile As String
    Dim 台帳ファイル名 As String
    Dim シート名 As String
    If Trim(TextBox1.Value) = "" Then
        MsgBox "ファイル名を入力してから実行してください。", 16, "保存"
        Exit Sub
    End If
    If TextBox1.Value Like "*[\/:*?""'#<>|]*" Then
        MsgBox TextBox1.Value & " は無効なファイル名です", 16, "保存"
        Exit Sub
    End If
    If Dir(ActiveWorkbook.Path & "\Da保存", 16) = "" Then MkDir ActiveWorkbook.Path & "\Da保存" '保存台帳フォルダがなかったら作成する
        シート名 = ActiveSheet.Name
        MyFile = ActiveWorkbook.Name
    If Kara = "Zi" Then '事業所台帳からの保存とファイル区分が違う
        With Worksheets("DATA")
            台帳ファイル名 = .Cells(1, 1).Value
            ファイル区分 = " " & Left(MyFile, Len(MyFile) - 4) & " " & Left(.Cells(1, 1).Value, Len(.Cells(1, 1).Value) - 4) & " " & ActiveSheet.Name & ".xls" '会社名＋現在日付で保存する
        End With
    Else
        ファイル区分 = " " & Left(MyFile, Len(MyFile) - 4) & " " & ActiveSheet.Name & ".xls" 'ブック名＋シート名で保存する
    End If
    保存ファイル名 = TextBox1.Value & " " & ファイル区分
    
    Dim フルパス As String
    フルパス = ActiveWorkbook.Path & "\Da保存\" & 保存ファイル名
    If 保存ファイル名 = Dir(フルパス) Then 'すでにあるかチェック
        If MsgBox("この保存ファイルはすでに存在します。上書きしますか？", 1 + 48, "保存") <> 1 Then
        MsgBox "処理を中止します。", 64, "保存"
        Exit Sub
        End If
    End If
    
    If MsgBox("ファイル名「" & TextBox1.Value & "」で保存します。よろしいですか？", 1 + 32, "保存") <> 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Workbooks.Add
    Cells.Select
    Selection.PasteSpecial Paste:=xlValues
    Range("A1").Select
    Application.CutCopyMode = False

    Label4.Caption = "保存しています・・"
    Me.Repaint


    If Val(Application.Version) < 12 Then
        ActiveWorkbook.SaveAs Filename:=フルパス
    Else
        ActiveWorkbook.SaveAs Filename:=フルパス, FileFormat:=56
    End If

    ActiveWorkbook.Close False
    Workbooks(MyFile).Activate
    Label4.Caption = ""
    Me.Repaint
     MsgBox "保存しました。", 64, "保存"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
Unload Me
End Sub
Private Sub UserForm_Initialize()
    Application.ScreenUpdating = True
    Me.Caption = ActiveSheet.Name & "の保存"
    If Worksheets("MENU").Cells(1, 1).Value = 1 Then
        If ActiveSheet.Name = "退職金" Then
        TextBox1.Value = Cells(11, 3).Value & " " & Format(Cells(22, 5).Value, "geemmdd")
        Else
        TextBox1.Value = Worksheets("退職金").Cells(11, 9).Value
        End If
    End If
    TextBox1.SetFocus
    TextBox1.SelStart = 0
    TextBox1.SelLength = TextBox1.TextLength
    On Error GoTo ErrorC
    Kara = ""
    If Right(Worksheets("DATA").Cells(1, 1).Value, 6) = "da.xls" Then
        Kara = "Zi"
        End If
    Exit Sub
ErrorC:
End Sub

Attribute VB_Name = "入力"
Attribute VB_Base = "0{9203843E-DF8C-4545-BEC4-3AC327E8A6DF}{0EA17A71-B35F-465A-8655-90779C2EEC28}"
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 T As Worksheet
Dim i As Integer

Private Sub CommandButton1_Click()
T.Cells(11, 9).Value = TextBox1.Value
T.Cells(11, 3).Value = TextBox2.Value
T.Cells(26, 5).Value = TextBox3.Value
T.Cells(18, 9).Value = TextBox3.Value
T.Cells(20, 17).Value = ComboBox1.Value
T.Cells(20, 18).Value = ComboBox2.Value
T.Cells(20, 19).Value = ComboBox3.Value
T.Cells(21, 17).Value = ComboBox4.Value
T.Cells(21, 18).Value = ComboBox5.Value
T.Cells(21, 19).Value = ComboBox6.Value
T.Cells(22, 17).Value = ComboBox7.Value
T.Cells(22, 18).Value = ComboBox8.Value
T.Cells(22, 19).Value = ComboBox9.Value
T.Cells(21, 20).Value = ComboBox11.Value
T.Cells(20, 20).Value = ComboBox12.Value

T.Cells(24, 16).Value = ComboBox10.Value

T.Cells(18, 5).Value = T.Cells(20, 22).Value
T.Cells(20, 5).Value = T.Cells(21, 22).Value
T.Cells(22, 5).Value = T.Cells(22, 22).Value
T.Cells(16, 20).Value = CheckBox1.Value '20130115 titti


T.Range("E24").FormulaR1C1 = "=VALUE(FNCNENREI(R[-4]C,R[-2]C))"
    T.Range("E28").FormulaR1C1 = "=R26C9"
    T.Range("E30").FormulaR1C1 = "=R28C9+R30C9"
    T.Range("E32").FormulaR1C1 = "=+R[-4]C+R[-2]C"
    T.Range("E34").FormulaR1C1 = "=+R[-8]C-R[-2]C"
    T.Range("I18").FormulaR1C1 = "=+R26C5"
    T.Range("I20").FormulaR1C1 = "=IF(R[-2]C>R16C16,R16C16,R[-2]C)"
    T.Range("I22").FormulaR1C1 = "=IF(R[-4]C<R[-6]C[7],0,R[-4]C-R[-6]C[7])"
    T.Range("I24").FormulaR1C1 = "=ROUNDDOWN(R[-2]C/IF(R16C21=TRUE,1,2),-3)" '20130115 titti
'20071105 kon
'    T.Range("I26").FormulaR1C1 = _
'        "=R[-2]C*VLOOKUP(R[-2]C,TABLE!R9C2:R14C4,2)-VLOOKUP(R[-2]C,TABLE!R9C2:R14C4,3)"
'20130111 kon #20374
'20130111 kon
'    T.Range("I26").FormulaR1C1 = _
'        "=ROUNDDOWN(R[-2]C*VLOOKUP(R[-2]C,TABLE!R9C2:R14C4,2)-VLOOKUP(R[-2]C,TABLE!R9C2:R14C4,3),-2)"
    T.Range("I26").FormulaR1C1 = _
        "=ROUNDDOWN((R[-2]C*VLOOKUP(R[-2]C,TABLE!R9C2:R14C4,2)-VLOOKUP(R[-2]C,TABLE!R9C2:R14C4,3))*1.021,0)"
    
    
    T.Range("I28").FormulaR1C1 = _
        "=ROUNDDOWN(R24C9*0.06,-2)" '20130115 titti
    T.Range("I30").FormulaR1C1 = _
        "=ROUNDDOWN(R24C9*0.04,-2)" '20130115 titti
    T.Range("I32").FormulaR1C1 = "=+R[-6]C+R[-4]C+R[-2]C"
    T.Range("I34").FormulaR1C1 = "=+R[-16]C-R[-2]C"
Application.Calculation = xlCalculationAutomatic
T.Range(T.Cells(18, 3), T.Cells(34, 9)).Value = T.Range(T.Cells(18, 3), T.Cells(34, 9)).Value2
Unload Me
退職金.Show
End Sub

Private Sub CommandButton4_Click() '20111122 masa YBNO
    フォーム台帳ファイル.Label7.Caption = "入力"
    フォーム台帳ファイル.Show
End Sub

Private Sub UserForm_Initialize()
Set T = Worksheets("退職金")
If Worksheets("MENU").Cells(1, 1).Value = 1 Then
CommandButton4.Visible = False
End If

TextBox1.Value = T.Cells(11, 9).Value
TextBox2.Value = T.Cells(11, 3).Value
TextBox3.Value = T.Cells(26, 5).Value
CheckBox1.Value = T.Cells(16, 20).Value '20130115 titti

For i = 1 To 64
ComboBox1.AddItem i
ComboBox4.AddItem i
ComboBox7.AddItem i
Next
For i = 1 To 12
ComboBox2.AddItem i
ComboBox5.AddItem i
ComboBox8.AddItem i
Next
For i = 1 To 31
ComboBox3.AddItem i
ComboBox6.AddItem i
ComboBox9.AddItem i
Next

ComboBox1.Value = T.Cells(20, 17).Value
ComboBox2.Value = T.Cells(20, 18).Value
ComboBox3.Value = T.Cells(20, 19).Value
ComboBox4.Value = T.Cells(21, 17).Value
ComboBox5.Value = T.Cells(21, 18).Value
ComboBox6.Value = T.Cells(21, 19).Value
ComboBox7.Value = T.Cells(22, 17).Value
ComboBox8.Value = T.Cells(22, 18).Value
ComboBox9.Value = T.Cells(22, 19).Value

ComboBox11.AddItem "昭和"
ComboBox11.AddItem "平成"
ComboBox11.Value = T.Cells(21, 20).Value
ComboBox12.List = ComboBox11.List
ComboBox12.Value = T.Cells(20, 20).Value

ComboBox10.AddItem "一般退職"
ComboBox10.AddItem "障害退職"
ComboBox10.Value = T.Cells(24, 16).Value

TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
End Sub


Attribute VB_Name = "退職金の計算"
Attribute VB_Base = "0{21F68370-8F2D-41B9-AC69-943E2B575A33}{572DCADC-F0DC-4FE9-8154-7FEAB322A360}"
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 T As Worksheet
Dim i As Integer

Private Sub CommandButton1_Click()
T.Cells(62, 6).Value = TextBox2.Value
T.Cells(64, 6).Value = TextBox3.Value
T.Cells(52, 6).Value = ComboBox1.Value
T.Cells(52, 7).Value = ComboBox2.Value
T.Cells(52, 8).Value = ComboBox3.Value

T.Cells(53, 6).Value = ComboBox4.Value
T.Cells(53, 7).Value = ComboBox5.Value
T.Cells(53, 8).Value = ComboBox6.Value
T.Cells(54, 6).Value = ComboBox7.Value
T.Cells(54, 7).Value = ComboBox8.Value
T.Cells(54, 8).Value = ComboBox9.Value
T.Cells(53, 9).Value = ComboBox11.Value
T.Cells(52, 9).Value = ComboBox12.Value

T.Cells(58, 5).Value = ComboBox10.Value
T.Cells(56, 6).Value = OptionButton1.Value
T.Cells(60, 6).Value = TextBox4.Value
Unload Me
退職金2.Show
End Sub

Private Sub CommandButton3_Click()
Sheets("支給率").Select
Unload Me
End Sub
Private Sub CommandButton4_Click() '20111122 masa YBNO

フォーム台帳ファイル.Label7.Caption = "退職金の計算"
フォーム台帳ファイル.Show

End Sub

Private Sub UserForm_Initialize()
Set T = Worksheets("MENU")
If Worksheets("MENU").Cells(1, 1).Value = 1 Then
CommandButton4.Visible = False
End If

TextBox2.Value = T.Cells(62, 6).Value
TextBox3.Value = T.Cells(64, 6).Value
TextBox4.Value = T.Cells(60, 6).Value
For i = 1 To 64
ComboBox1.AddItem i
ComboBox4.AddItem i
ComboBox7.AddItem i
Next
For i = 1 To 12
ComboBox2.AddItem i
ComboBox5.AddItem i
ComboBox8.AddItem i
Next
For i = 1 To 31
ComboBox3.AddItem i
ComboBox6.AddItem i
ComboBox9.AddItem i
Next
ComboBox1.Value = T.Cells(52, 6).Value
ComboBox2.Value = T.Cells(52, 7).Value
ComboBox3.Value = T.Cells(52, 8).Value
…