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, AAA
    Cancel = True
End Sub


Attribute VB_Name = "抽出"
Attribute VB_Base = "0{2086BEAD-6F54-4EC6-9F8D-663F2A45F8F0}{4BA2B5FC-D36B-422F-8E57-472CE4095D2B}"
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

Private Sub CheckBox1_Click()
For n = 0 To ListBox1.ListCount - 1
ListBox1.Selected(n) = CheckBox1.Value
Next
End Sub

Private Sub CommandButton1_Click()
Dim i 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, AAA
Exit Sub
End If
Application.ScreenUpdating = False
Range(Cells(6, 2), Cells(Cells(10000, 3).End(xlUp).Row + 10, 25)).ClearContents
n = 6

If Worksheets("MENU").Cells(1, 1).Value = "" Then '単体
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Workbooks.Open ActiveWorkbook.Path & "\Da保存\" & ListBox1.List(i, 0) & ".xls"
            ThisWorkbook.Activate
            Sheets("一覧表").Select
            With Workbooks(ListBox1.List(i, 0) & ".xls").Worksheets("Copy")
                Range(Cells(n, 2), Cells(n, 25)).Value = .Range(.Cells(9, 59), .Cells(9, 82)).Value
                n = n + 1
                Workbooks(ListBox1.List(i, 0) & ".xls").Close False
                ThisWorkbook.Activate
            End With
        End If
    Next
Else '結果的に台帳
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Workbooks.Open ActiveWorkbook.Path & "\Da保存\年調" & ListBox1.List(i, 0) & ".xls"
            ThisWorkbook.Activate
            Sheets("一覧表").Select
            With Workbooks("年調" & ListBox1.List(i, 0) & ".xls").Worksheets("Copy")
                Range(Cells(n, 2), Cells(n, 25)).Value = .Range(.Cells(9, 59), .Cells(9, 82)).Value
                n = n + 1
                Workbooks("年調" & ListBox1.List(i, 0) & ".xls").Close False
                ThisWorkbook.Activate
            End With
        End If
    Next
End If

'一覧表シートのデータがNo順に並ぶように修正 YB12457 20120822 toki
    Dim k As Long
    k = Cells(10000, 2).End(xlUp).Row
   
    If k >= 6 Then
    Worksheets("一覧表").Range("B6:Y" & k).Sort Key1:=Range("B6"), order1:=xlAscending
    End If

Range(Cells(n + 1, 5), Cells(n + 1, 24)).FormulaR1C1 = "=SUM(R6C:R[-1]C)"
Range(Cells(n + 1, 5), Cells(n + 1, 24)).Value = Range(Cells(n + 1, 5), Cells(n + 1, 24)).Value2
Cells(n + 1, 4).Value = "計"
MsgBox (n - 6) & "件抽出しました。", 64, AAA

    Unload Me
    Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
    If Worksheets("MENU").Cells(1, 1).Value = "" Then '単体
    ファイル名 = Dir(ActiveWorkbook.Path & "\Da保存\*.xls")
    Do While ファイル名 <> ""
        With ListBox1
            .AddItem Left(ファイル名, Len(ファイル名) - 4)  '
            ファイル名 = Dir()
        End With
    Loop
    ElseIf Worksheets("MENU").Cells(1, 1).Value = 1 Then '台帳
    ファイル名 = Dir(ActiveWorkbook.Path & "\Da保存\年調*.xls")
    Do While ファイル名 <> ""
        n = Len(ファイル名) - 4
        With ListBox1
            .AddItem Right(Left(ファイル名, n), Len(Left(ファイル名, n)) - 2) '
            ファイル名 = Dir()
        End With
    Loop
    Else
    MsgBox "データがありません。", 16, "年末調整"
    End If
End Sub

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












Attribute VB_Name = "年末調整フォーム"
Attribute VB_Base = "0{51B89217-F888-4D35-8BAA-9727BA217838}{6E369497-E4F9-4798-BBE4-34AA9EC36AA9}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
Dim i As Integer

Private Sub CommandButton1_Click()
    If Combo78.Value = "無" Then
        If Text113.Value = "" Or (Val(Text113) >= 380001 And Val(Text113) <= 759999) Then
            Else
            MsgBox "配偶者区分が「無」の場合は、配偶者所得金額は「空白」か380,001円から759,999円の範囲で入力してください。", 16, AAA
            Exit Sub
        End If
    Else
        If Text113.Value = "" Then
            Else
            MsgBox "配偶者区分が「無」ではない場合は、配偶者特別控除は受けられませんので、配偶者所得金額は空欄にして下さい。", 16, AAA
            Exit Sub
        End If
    End If
    If Val(Text106.Value) > 0 Then
        If Val(Text107.Value) < Val(Text106.Value) Then
            MsgBox "国民年金保険料は社会保険料申告分の範囲内で入力してください。", 16, AAA
            Exit Sub
        End If
    End If
    
    
    Cells(14, 3).Value = TextBox7.Value
    Cells(6, 33).Value = TextBox1.Value
    Cells(5, 33).Value = TextBox2.Value
    Cells(7, 35).Value = TextBox3.Value
    Cells(5, 6).Value = TextBox4.Value
    Cells(5, 12).Value = TextBox5.Value
    Cells(6, 16).Value = TextBox6.Value
    Cells(6, 24).Value = TextBox9.Value
    
    Cells(5, 44).Value = TextBox8.Value
    
    For i = 68 To 78
        If i = 73 Then
            Cells(i - 58, 57).Value = Text73.Value '20111012
        Else
            If i <> 69 Then Cells(i - 58, 57).Value = Controls("Combo" & i).ListIndex
        End If
    Next
    For i = 79 To 88
        If i >= 83 And i <= 85 Then '20111012
        Else
        Cells(i - 58, 57).Value = Controls("Text" & i).Value
        End If
    Next
    For i = 103 To 114
        Cells(i - 70, 57).Value = Controls("Text" & i).Value
    Next
        For i = 58 To 65
    Cells(i, 57).Value = Controls("Text" & i).Value
    Next
    
    Cells(45, 57).Value = CheckBox1.Value
    Cells(8, 57).Value = CheckBox2.Value
    MsgBox "登録しました", 64, AAA
    Unload Me
End Sub

Private Sub CommandButton2_Click()
If Cells(1, 47).Value = 1 Then
Cells(1, 47).Value = ""
MsgBox "非表示にしました。", 64, AAA
Else
Cells(1, 47).Value = 1
MsgBox "直接入力する箇所を表示しました。", 64, AAA
End If
Application.Calculation = xlAutomatic
Application.Calculation = xlManual

End Sub

Private Sub CommandButton3_Click()
会社情報.Show
End Sub

Private Sub Text103_Change()

End Sub

Private Sub UserForm_Activate()
    Combo68.AddItem "無"
    Combo68.AddItem "一般"
    Combo68.AddItem "特別障害者"
    'Combo69.AddItem "無" '20050801
    'Combo69.AddItem "老年者"
    Combo70.AddItem "無"
    Combo70.AddItem "一般"
    Combo70.AddItem "特別"
    Combo71.AddItem "無"
    Combo71.AddItem "寡夫"
    Combo72.AddItem "無"
    Combo72.AddItem "勤労学生"
    'Combo73.AddItem "無" '20050801
    'Combo73.AddItem "夫あり"
    Combo74.AddItem "無"
    Combo74.AddItem "未成年者"
    Combo75.AddItem "無"
    Combo75.AddItem "乙欄"
    Combo76.AddItem "無"
    Combo76.AddItem "災害者"
    Combo77.AddItem "無"
    Combo77.AddItem "外国人"
    Combo78.AddItem "無"
    Combo78.AddItem "一般"
    Combo78.AddItem "老人"
    'Combo78.AddItem "同居特別障害者一般"
    'Combo78.AddItem "同居特別障害者老人"
    
    TextBox7.Value = Cells(14, 3).Value
    TextBox1.Value = Cells(6, 33).Value
    TextBox2.Value = Cells(5, 33).Value
    TextBox3.Value = Cells(7, 35).Value
    TextBox4.Value = Cells(5, 6).Value
    TextBox5.Value = Cells(5, 12).Value
    TextBox6.Value = Cells(6, 16).Value
    TextBox9.Value = Cells(6, 24).Value
    TextBox8.Value = Cells(5, 44).Value
    
    For i = 68 To 78
        If i = 73 Then
            Text73.Value = Cells(i - 58, 57).Value '20111012
            Else
            If i <> 69 Then Controls("Combo" & i).ListIndex = Cells(i - 58, 57).Value
        End If
    Next
    For i = 79 To 88
        If i >= 83 And i <= 85 Then '20111012
        Else
        Controls("Text" & i).Value = Cells(i - 58, 57).Value
        End If
    Next
    For i = 103 To 114
        Controls("Text" & i).Value = Cells(i - 70, 57).Value
    Next
    For i = 58 To 65
        Controls("Text" & i).Value = Cells(i, 57).Value
    Next
    
    CheckBox1.Value = IIf(Cells(45, 57).Value = "", False, Cells(45, 57).Value)
    CheckBox2.Value = IIf(Cells(8, 57).Value = "", True, Cells(8, 57).Value)
    
    Application.Calculation = xlManual
    MultiPage1.Value = 0
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   Application.Calculation = xlAutomatic
End Sub

Attribute VB_Name = "Module1"
'***修正履歴
'       単体版とマニュアルの位置を統一　　20071105 kon
'源泉徴収票と年調一覧表で損害保険料が地震保険に変わっていなかったため修正  20071126 KON(シート)
'20年の年末調整は19年と変わらないため、起動画面と、源泉徴収票の年度を変更
'       源泉徴収簿の年度（Ｃ14）を変更すると源泉徴収簿も変更するように変更（シート）20080918 kon
Option Explicit
Public Const AAA As String = "年末調整計算"
Sub 初期処理()
SyokiSyori
Sheets("MENU").Select
Cells(1, 1).Value = 1 '台帳からの印
End Sub
Sub Auto_Open()
SyokiSyori
Sheets("MENU").Select
Cells(1, 1).Value = ""   '単体からの印
End Sub
Sub SyokiSyori()
    Application.ScreenUpdating = False
    Dim s As Worksheet
    For Each s In Worksheets
        With s
            .Activate
            ActiveWindow.DisplayHeadings = False
            .EnableSelection = xlUnlockedCells
            .Protect UserInterfaceOnly:=True
        End With
    Next
    ActiveWindow.DisplayWorkbookTabs = False
End Sub
Sub MENUへ()
Sheets("MENU").Select
End Sub

Sub 年調データ入力()
年末調整フォーム.Show
End Sub
Sub クリア()
If MsgBox("現在データをクリアしてもいいですか？", 1 + 32, "クリア") <> 1 Then Exit Sub
        Range( _
        "F5:I7,L5:N7,P6:AC7,AG5:AO6,AI7:AN7,AR5:AU7,H11:M34,R11:U34,H37:M42,R37:U42,BE8:BE66" _
        ).ClearContents

End Sub
Sub 源泉徴収簿へ()
Sheets("源泉徴収簿").Select
End Sub
Sub 源泉徴収票へ()
Sheets("源泉徴収票").Select
End Sub
Sub 年調一覧表へ()
Sheets("一覧表").Select
End Sub
Sub 印刷へ()
If MsgBox("プリンタの準備はいいですか？", 1 + 32, "印刷") <> 1 Then Exit Sub
ActiveSheet.PrintOut
End Sub
Sub すべてデータを戻す()
On Error Resume Next
If Cells(14, 3).Value < 23 Then '20111018 重
If MsgBox("平成22年以前データは扶養親族の登録形式が異なる一部のデータは取り込めません。よろしいですか？", 1 + 48, AAA) <> 1 Then Exit Sub
Else
If MsgBox("このデータを戻しますか？", 1 + 32, AAA) <> 1 Then Exit Sub
End If
With ThisWorkbook.Worksheets("源泉徴収簿")
.Range(.Cells(5, 4), .Cells(7, 47)).Value = Range(Cells(5, 4), Cells(7, 47)).Value2
.Range(.Cells(11, 5), .Cells(34, 13)).Value = Range(Cells(11, 5), Cells(34, 13)).Value2
.Range(.Cells(11, 18), .Cells(32, 23)).Value = Range(Cells(11, 18), Cells(32, 23)).Value2
.Range(.Cells(33, 18), .Cells(34, 21)).Value = Range(Cells(33, 18), Cells(34, 21)).Value2
.Range(.Cells(37, 5), .Cells(40, 7)).Value = Range(Cells(37, 5), Cells(40, 7)).Value2
.Range(.Cells(37, 8), .Cells(42, 13)).Value = Range(Cells(37, 8), Cells(42, 13)).Value2
.Range(.Cells(37, 18), .Cells(42, 23)).Value = Range(Cells(37, 18), Cells(42, 23)).Value2
.Range(.Cells(8, 57), .Cells(65, 57)).Value = Range(Cells(8, 57), Cells(65, 57)).Value2
If Cells(14, 3).Value < 23 Then '20111018 重
    .Range(.Cells(24, 57), .Cells(28, 57)).ClearContents
    If .Cells(20, 57).Value > 2 Then .Cells(20, 57).Value = 1
End If
.Range(.Cells(6, 3), .Cells(14, 3)).Value = Range(Cells(6, 3), Cells(14, 3)).Value2
.Cells(6, 56).Value = Cells(6, 56).Value
.Cells(6, 57).Value = Cells(6, 57).Value
.Cells(5, 56).Value = Cells(5, 56).Value
ActiveWorkbook.Close False
ThisWorkbook.Activate
End With
End Sub
Sub 氏名データを戻す()
On Error Resume Next
If MsgBox("氏名の行のデータを戻しますか？", 1 + 32, AAA) <> 1 Then Exit Sub
With ThisWorkbook.Worksheets("源泉徴収簿")
.Range(.Cells(5, 4), .Cells(7, 47)).Value = Range(Cells(5, 4), Cells(7, 47)).Value2
.Range(.Cells(5, 56), .Cells(6, 57)).Value = Range(Cells(5, 56), Cells(6, 57)).Value2
.Range(.Cells(8, 57), .Cells(65, 57)).Value = Range(Cells(8, 57), Cells(65, 57)).Value2
.Cells(6, 56).Value = Cells(6, 56).Value
.Cells(6, 57).Value = Cells(6, 57).Value
.Cells(5, 56).Value = Cells(5, 56).Value
ActiveWorkbook.Close False
ThisWorkbook.Activate
End With
End Sub
Sub 終了()
If MsgBox("終了しますか？", 1 + 32, "終了") <> 1 Then Exit Sub
Application.DisplayAlerts = False
Dim wb As Workbook
Dim n As Integer
n = 0
For Each wb In Workbooks
If wb.Name Like "*.xls" Then
n = n + 1
If n = 2 Then Exit For
End If
Next
If n = 2 Then
Call 閉じる
Else
Application.Quit
End If
End Sub
Sub 閉じる()
    Application.OnTime Now + TimeValue("00:00:01"), "CloseActiveWorkbook"
End Sub
Sub CloseActiveWorkbook()
    ActiveWorkbook.Close False
End Sub

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

    
    Sheets("源泉徴収票").Select
    Range("AB33:AM33").ClearContents
    Range("A1").Select
    Sheets("源泉徴収簿").Select
    Range( _
        "F11:M34,E37:M40,H41:M42,R11:U34,R37:U42,BD5:BE6,BE8:BE65,F5:I7,L5:N7,P6:AC7,AG5:AO5,AG6:AN6,AI7:AN7,AR5:AU7" _
        ).Select
    Selection.ClearContents
    Selection.ClearContents
    Range("A1").Select
    Sheets("一覧表").Select
    Range("B6:Y" & Cells(1000, 3).End(xlUp).Row + 10).Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("MENU").Select
    Range("E5").Select
End Sub


Attribute VB_Name = "Module2"
Option Explicit
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 OpenManual()
    Dim strPath As String
    Dim lngRet As Long
    Dim Manu As String
        Manu = "年末調整.pdf"
'20071105 kon
'    strPath = ThisWorkbook.Path & "\" & Manu
    strPath = ThisWorkbook.Path & "\マニュアル\" & Manu
    lngRet = ShellExecute(0, "Open", strPath & vbNullString, _
                          vbNullString, vbNullString, SW_SHOWNORMAL)
    Select Case lngRet
        Case SE_ERR_NOASSOC
            MsgBox "PDFファイルを開くことができません。", 16, AAA
        Case ERROR_FILE_NOT_FOUND
            MsgBox "このシートのマニュアルはありません。", 16, AAA
    End Select
End Sub

Sub 保存へ()
    Dim 保存ファイル名 As String
    Dim ファイル区分 As String
    Dim フルパス As String
    If Trim(Cells(6, 33).Value) = "" Then
    MsgBox "社員名を入力してから実行してください。", 16, "保存"
    Exit Sub
    End If

    
    If Dir(ActiveWorkbook.Path & "\Da保存", 16) = "" Then MkDir ActiveWorkbook.Path & "\Da保存" '保存台帳フォルダがなかったら作成する
    
    ファイル区分 = " 平成" & Cells(14, 3).Value & "年.xls" '
    If Worksheets("MENU").Cells(1, 1).Value = "" Then '単体
    保存ファイル名 = Cells(6, 33).Value & " " & ファイル区分
    ElseIf Worksheets("MENU").Cells(1, 1).Value = 1 Then '台帳
    保存ファイル名 = "年調" & Cells(6, 33).Value & " " & ファイル区分
    End If
    
    
    フルパス = ActiveWorkbook.Path & "\Da保存\" & 保存ファイル名
    If 保存ファイル名 = Dir(フルパス) Then 'すでにあるかチェック
        If MsgBox("この保存ファイルはすでに存在します。上書きしますか？", 1 + 48, AAA) <> 1 Then
        MsgBox "処理を中止します。", 64, AAA
        Exit Sub
        End If
    End If
    
    If MsgBox("「" & Cells(6, 33).Value & "さん」を保存します。よろしいですか？", 1 + 32, AAA) <> 1 Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Cells.Copy
    Range("A1").Select
    
    Workbooks.Open ActiveWorkbook.Path & "\GKeepFile.xls"
    Sheets("Copy").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlValues
    Selection.PasteSpecial Paste:=xlFormats
    Cells(1, 47).Value = ""
    Range("A1").Select
    
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs フルパス '保存する
    ActiveWorkbook.Close False
    ThisWorkbook.Activate

    
     MsgBox "「保存データ」を作成しました。", 64, AAA
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Sub 一覧保存へ()
'20091209　ban追加
    If Worksheets("MENU").Cells(1, 1).Value = "" Then '単体にはDaAddinがないので
    MsgBox "年調一覧表の保存/読込は「台帳」版のみ利用できます。", 64, AAA
    ElseIf Worksheets("MENU").Cells(1, 1).Value = 1 Then '台帳

    If Trim(Cells(6, 3).Value) = "" Then
    MsgBox "一覧表を作成してから実行してください。", 16, "保存"
    Exit Sub
    End If

    Dim MyName As String
    
    MyName = "作成日" & 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 If
End Sub
Sub 保存読込へ()
Da保存読込.Show
End Sub
Sub 一覧保存読込へ()
'20091209　ban追加
    If Worksheets("MENU").Cells(1, 1).Value = "" Then '単体にはDaAddinがないので
    MsgBox "年調一覧表の保存/読込は「台帳」版のみ利用できます。", 64, AAA
    ElseIf Worksheets("MENU").Cells(1, 1).Value = 1 Then '台帳
    Da保存読込一覧.Show
    End If
End Sub
Sub 抽出へ()
抽出.Show
End Sub
Sub 一覧表の印刷()
If MsgBox("プリンタの準備はいいですか？", 1 + 32, "印刷") <> 1 Then Exit Sub
Range(Cells(6, 2), Cells(Cells(10000, 5).End(xlUp).Row, 25)).PrintOut
End Sub

Attribute VB_Name = "Da保存読込"
Attribute VB_Base = "0{F325D0CD-C990-4009-98C7-3DBD2F9574C5}{510F29C6-7C67-4E76-A54E-5A646C00D51E}"
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
Private Sub CommandButton1_Click()
    If ListBox1.ListIndex = -1 Then
        MsgBox "ファイルが選択されていません", 16, AAA
        Exit Sub
    End If
    Application.ScreenUpdating = False
    If Worksheets("MENU").Cells(1, 1).Value = "" Then '単体
    Workbooks.Open ActiveWorkbook.Path & "\Da保存\" & ListBox1.Value & ".xls"
    ElseIf Worksheets("MENU").Cells(1, 1).Value = 1 Then '台帳
    Workbooks.Open ActiveWorkbook.Path & "\Da保存\年調" & ListBox1.Value & ".xls"
    End If
    Unload Me
    MsgBox "OK", 64, AAA
    Application.ScreenUpdating = True
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
    If Worksheets("MENU").Cells(1, 1).Value = "" Then '単体
    Kill ActiveWorkbook.Path & "\Da保存\" & ListBox1.Value & ".xls"
    ElseIf Worksheets("MENU").Cells(1, 1).Value = 1 Then '台帳
    Kill ActiveWorkbook.Path & "\Da保存\年調" & ListBox1.Value & ".xls"
    End If
    ListBox1.RemoveItem ListBox1.ListIndex
    MsgBox "削除しました", 64, AAA
End Sub

Private Sub CommandButton3_Click()
    Dim i As Integer
    If Trim(TextBox1.Value) = "" Then
        MsgBox "検索する文字列を入力して下さい。", 16, AAA
        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, AAA

End Sub

Private Sub TextBox1_Change()
MyCheck = False
End Sub

Private Sub UserForm_Initialize()
    If Worksheets("MENU").Cells(1, 1).Value = "" Then '単体
    ファイル名 = Dir(ActiveWorkbook.Path & "\Da保存\*.xls")
    Do While ファイル名 <> ""
        With ListBox1
            .AddItem Left(ファイル名, Len(ファイル名) - 4)  '
            ファイル名 = Dir()
        End With
    Loop
    ElseIf Worksheets("MENU").Cells(1, 1).Value = 1 Then '台帳
    ファイル名 = Dir(ActiveWorkbook.Path & "\Da保存\年調*.xls")
    Do While ファイル名 <> ""
        n = Len(ファイル名) - 4
        With ListBox1
            .AddItem Right(Left(ファイル名, n), Len(Left(ファイル名, n)) - 2) '
            ファイル名 = Dir()
        End With
    Loop
    Else
    MsgBox "データがありません。", 16, "年末調整"
    End If
End Sub

Attribute VB_Name = "会社情報"
Attribute VB_Base = "0{9B7E57D9-6996-48CA-81F7-ED2A3A4015B6}{927B4812-8FCB-46F1-A97A-E32FA1294720}"
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()
Cells(6, 56).Value = TextBox1.Value
Cells(6, 57).Value = TextBox2.Value
Cells(5, 56).Value = TextBox3.Value
MsgBox "登録しました。", 64, AAA
Unload Me
End Sub

Private Sub UserForm_Activate()
TextBox1.Value = Cells(6, 56).Value
TextBox2.Value = Cells(6, 57).Value
TextBox3.Value = Cells(5, 56).Value

End Sub


Attribute VB_Name = "Da保存読込一覧"
Attribute VB_Base = "0{333ED4D9-9D88-4F7F-ADAD-CE2DB2B831F8}{E307DD9E-DF90-46CD-9D5F-9D04264CB5CD}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False




'20091209　ban追加
Option Explicit
Dim n As Integer
Dim ファイル名 As String
Dim ファイル区分 As String
Dim MyFile As String
Dim MyCheck As Boolean
Private Sub CommandButton1_Click()
    If ListBox1.ListIndex = -1 Then
        MsgBox "ファイルが選択されていません", 16, AAA
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Workbooks.Open ActiveWorkbook.Path & "\Da保存\" & ListBox1.Value & "年末調整 一覧表.xls"
    Unload Me
    MsgBox "OK", 64, AAA
    Application.ScreenUpdating = True
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
    If Worksheets("MENU").Cells(1, 1).Value = "" Then '単体
    Kill ActiveWorkbook.Path & "\Da保存\" & ListBox1.Value & ".xls"
    ElseIf Worksheets("MENU").Cells(1, 1).Value = 1 Then '台帳
    Kill ActiveWorkbook.Path & "\Da保存\" & ListBox1.Value & "年末調整 一覧表.xls"
    End If
    ListBox1.RemoveItem ListBox1.ListIndex
    MsgBox "削除しました", 64, AAA
End Sub

Private Sub CommandButton3_Click()
    Dim i As Integer
    If Trim(TextBox1.Value) = "" Then
        MsgBox "検索する文字列を入力して下さい。", 16, AAA
        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, AAA

End Sub

Private Sub TextBox1_Change()
MyCheck = False
End Sub

Private Sub UserForm_Initialize()
    If Worksheets("MENU").Cells(1, 1).Value = 1 Then '台帳
    ファイル名 = Dir(ActiveWorkbook.Path & "\Da保存\*年末調整*.xls")
    Do While ファイル名 <> ""
        n = Len(ファイル名) - 12
        With ListBox1
            .AddItem Right(Left(ファイル名, n), Len(Left(ファイル名, n)))  '
            ファイル名 = Dir()
        End With
    Loop
    Else
    MsgBox "データがありません。", 16, "年末調整"
    End If
End Sub