MALICIOUS
102
Risk Score
Malware Insights
MITRE ATT&CK
T1059.005 Visual Basic
T1566.001 Spearphishing Attachment
T1037.001 Windows: CreateProcess
T1037.001 Windows: ShellExecute
The sample is an Excel file containing VBA macros, which are often used to download and execute further malicious content. The presence of CreateProcess and ShellExecute API calls within the macros strongly suggests an intent to launch external processes. The document body, while appearing to be a labor condition notification, is likely a lure to encourage macro execution.
Heuristics 4
-
Reference to CreateProcess API high SC_STR_CREATEPROCESSReference to CreateProcess API
-
Reference to ShellExecute API high SC_STR_SHELLEXECReference to ShellExecute API
-
VBA macros detected medium OLE_VBA_MACROSDocument contains VBA macro code
-
Embedded URL info EMBEDDED_URLOne or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.URL http://get.adobe.com/jp/reader/ In document text (OLE body)
Extracted artifacts 1
Files carved from inside the sample during analysis.
| Filename | Kind | Source | Size |
|---|---|---|---|
macros.bas |
vba-macro | oletools.olevba.extract_macros (decoded VBA source) | 223103 bytes |
SHA-256: 3fda080440ac2d3120261d7e8df0f698cb72e6b69c8cf7db28414fc2b737f92b |
|||
Preview scriptFirst 1,000 lines of the extracted script
Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit
Attribute VB_Name = "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
Private Sub TextBox1_Change()
ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(Cells(10, 39).Value / 3)
End Sub
Private Sub TextBox2_Change()
ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(Cells(10, 40).Value / 3)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
End Sub
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{020EB672-8537-487D-B630-6BEDD02DE778}{48FE7F0B-AB37-411F-BCAD-5B351ED6AC64}"
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 MyFile As String
Private Sub CheckBox2_Click()
'20081202 kon
If CheckBox2.Value = True Then
CheckBox5.Enabled = True
'YBNO 29507 ito 20151120
''20100301masa
'CheckBox6.Enabled = True
Frame4.Enabled = True
Label22.Enabled = True
Else
CheckBox5.Enabled = False
CheckBox5.Value = False
'YBNO 29507 ito 20151120
''20100301masa
'CheckBox6.Enabled = False
'CheckBox6.Value = False
'CheckBox9.Enabled = False
'CheckBox9.Value = False
Frame4.Enabled = False
Label22.Enabled = False
End If
End Sub
Private Sub CheckBox6_Click()
'201002
If CheckBox6.Value = True Then
CheckBox9.Enabled = True
Else
CheckBox9.Enabled = False
CheckBox9.Value = False
End If
End Sub
'YBNO 30084 ito 20160201 ダミー番号 -------
Private Sub ComboBox1_Change()
If ComboBox1.Text = "2 再取得" Then
CheckBox10.Enabled = True
Else
CheckBox10.Enabled = False
End If
End Sub
'YBNO 30084 ito 20160201 ここまで ---------
Private Sub CommandButton2_Click()
If ListBox1.ListIndex = -1 Then
MsgBox "リストを選択してください。", 16, AAA
Exit Sub
End If
If TextBox19.Text <> vbNullString Then
If Application.Run("DaAddin.xla!MNMode", True, False) Then
If Not Application.Run("DaAddin.xla!CallLogin", PROC_NAME, Workbooks(MyFile).Worksheets("会社情報")) Then Exit Sub
End If
End If
Application.Calculation = xlCalculationManual
Cells(1, 1).Value = Val(ListBox1.Value)
Cells(11, 21).Value = ComboBox1.Value
Cells(11, 21).Value = ComboBox1.Value
Cells(21, 4).Value = ComboBox2.Value
Cells(21, 11).Value = ComboBox3.Value
Cells(21, 21).Value = ComboBox5.Value
'YBNO 29507 ito 20151120
'Cells(21, 25).Value = ComboBox4.Value
Cells(21, 24).Value = ComboBox4.Value
Cells(21, 30).Value = TextBox1.Value '賃金
Cells(23, 30).Value = CheckBox2.Value '契約期間の定め
Cells(31, 30).Value = CheckBox3.Value '事務組合
Cells(19, 32).Value = CheckBox3.Value
'YBNO 29507 ito 20151120
''H20080604 masaya
'Cells(28, 22).Value = TextBox3.Value
'Cells(29, 22).Value = TextBox4.Value
'Cells(30, 22).Value = TextBox5.Value
'Cells(30, 25).Value = TextBox6.Value
'Cells(30, 27).Value = TextBox7.Value
'Cells(31, 24).Value = ComboBox6.Value
'If CheckBox4.Value = True Then
' Cells(32, 27).Value = "レ"
' Else
' Cells(32, 27).Value = ""
'End If
'Cells(33, 19).Value = TextBox8.Value
''契約期間 20080807 kon
''開始
'Cells(28, 30).Value = TextBox9.Value
'Cells(28, 31).Value = TextBox10.Value
'Cells(28, 32).Value = TextBox11.Value
''終了
'Cells(29, 30).Value = TextBox12.Value
'Cells(29, 31).Value = TextBox13.Value
'Cells(29, 32).Value = TextBox14.Value
If TextBox3.ListIndex > 0 Then
Cells(29, 4).Value = TextBox3.List(TextBox3.ListIndex, 1)
Cells(29, 35).Value = TextBox3.List(TextBox3.ListIndex, 0)
'YBNO 30379 ito 20160223 追加 ---------------
Else
Cells(29, 4).Value = ""
Cells(29, 35).Value = ""
'YBNO 30379 ito 20160223 ここまで -----------
End If
If TextBox4.ListIndex > 0 Then
Cells(29, 11).Value = TextBox4.List(TextBox4.ListIndex, 1)
Cells(29, 36).Value = TextBox4.List(TextBox4.ListIndex, 0)
'YBNO 30379 ito 20160223 追加 ---------------
Else
Cells(29, 11).Value = ""
Cells(29, 36).Value = ""
'YBNO 30379 ito 20160223 ここまで -----------
End If
Cells(25, 31).Value = IIf(TextBox5.Value = "", "", TextBox5.Value & "/" & TextBox6.Value & "/" & TextBox7.Value)
Cells(29, 25).Value = ComboBox6.Value
Cells(21, 27).Value = ComboBox7.Value
Cells(29, 27).Value = ComboBox8.Value
Cells(25, 20).Value = TextBox8.Value
'契約期間
'開始
Cells(28, 30).Value = Format(TextBox9.Value, "00")
Cells(28, 31).Value = Format(TextBox10.Value, "00")
Cells(28, 32).Value = Format(TextBox11.Value, "00")
'終了
Cells(29, 30).Value = Format(TextBox12.Value, "00")
Cells(29, 31).Value = Format(TextBox13.Value, "00")
Cells(29, 32).Value = Format(TextBox14.Value, "00")
'個人番号
Cells(9, 30).Value = TextBox19.Value
'契約更新条項の有無
'20081202 kon
' If CheckBox5.Value = True Then
' Cells(30, 30).Value = "TRUE"
' ElseIf CheckBox5.Value = False Then
' Cells(30, 30).Value = "FALSE"
' End If
If CheckBox2.Value = True Then
If CheckBox5.Value = True Then
Cells(30, 30).Value = "TRUE"
ElseIf CheckBox5.Value = False Then
Cells(30, 30).Value = "FALSE"
End If
Else
Cells(30, 30).Value = ""
End If
If CheckBox2.Value = True Then
If CheckBox6.Value = True Then
Cells(30, 31).Value = True
If CheckBox9.Value = True Then
Cells(31, 31).Value = True
ElseIf CheckBox9.Value = False Then
Cells(31, 31).Value = False
End If
ElseIf CheckBox6.Value = False Then
Cells(30, 31).Value = False
Cells(31, 31).Value = False
End If
Else
Cells(30, 31).Value = ""
' Cells(31, 31).Value = ""
End If
'事業所名
'YBNO 29507 ito 20151120
'Cells(30, 32).Value = TextBox15.Value
Cells(25, 7).Value = TextBox15.Value
'20081202 kon
' Cells(23, 8).Value = TextBox16.Value
'YBNO 28871/30074 ito 20160128
'Cells(23, 8).Value = TextBox16.Value
'Cells(23, 10).Value = TextBox17.Value
Cells(23, 31).Value = Format(TextBox16.Value, "00") & Format(TextBox17.Value, "00")
Cells(19, 32).Value = CheckBox7.Value 'YBNO 29507 ito 20151120
''' YBNO18519
'35行目に提出年月日を入れる
Cells(35, 31).Value = Me.txtApplyYear.Text
Cells(35, 32).Value = Me.txtApplyMonth.Text
Cells(35, 33).Value = Me.txtApplyDay.Text
''' END 18519
Cells(11, 31).Value = CheckBox10.Value 'YBNO 30084 ito 20160201 ダミー番号
'個人番号があるときにログを作る
'---------------------------------------------
If TextBox19.Text <> vbNullString Then
If Application.Run("DaAddin.xla!MNMode", True, False) Then
Dim guid As String
guid = Workbooks(MyFile).Worksheets("個人情報").Cells(ListBox1.List(ListBox1.ListIndex, 4), 200).Value
Dim ComAccount As String
ComAccount = Application.Run("業務日誌.xlam!GetCompanyData", Workbooks(MyFile))
Application.Run "DaAddin.xla!ProcLogging", ComAccount, PROC_NAME, "データ作成", vbNullString, guid, StrConv(ListBox1.List(ListBox1.ListIndex, 3), vbUpperCase), "成功"
End If
End If
'---------------------------------------------
Unload Me
End Sub
Private Sub CommandButton3_Click()
If ListBox1.ListIndex = -1 Then
MsgBox "被保険者を選択してから実行してください。", 16, "選択"
Exit Sub
End If
氏名変更.Show
End Sub
Private Sub CommandButton4_Click()
Dim i As Long
Dim n As Long
If Trim(TextBox18.Value) = "" Then '20130102 titti 要望 #20098
MsgBox "検索文字を入力してから実行してください。", 16, "検索"
Exit Sub
End If
If OptionButton2.Value = False Then
OptionButton2.Value = True
End If
ListBox2.Clear
n = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.List(i, 3) Like "*" & TextBox18.Value & "*" Then
ListBox2.AddItem i
ListBox2.List(n, 1) = ListBox1.List(i, 3)
n = n + 1
End If
Next
If n = 0 Then
MsgBox "「" & TextBox18.Value & "」は見つかりませんでした。", 16, "検索"
Else
ListBox2.ListIndex = 0
End If
End Sub
Private Sub CommandButton5_Click()
Dim id As String
If ListBox1.ListIndex <> -1 Then
If Application.Run("DaAddin.xla!MNMode", True, False) Then
id = Workbooks(MyFile).Worksheets("個人情報").Cells(ListBox1.List(ListBox1.ListIndex, 4), 200).Value
TextBox19.Text = Application.Run("DaAddin.xla!GetMyno", id, Workbooks(MyFile).Worksheets("会社情報"), PROC_NAME)
End If
End If
End Sub
Private Sub ListBox1_Click()
With Workbooks(MyFile).Worksheets("個人情報")
'------------------------------------------------------------------------------
'雅也修正(171201)'修正前 TextBox1.Value = .Cells(ListBox1.ListIndex + 6, 21).Value '健保の標準報酬月額
'20081201 kon
' TextBox1.Value = Int(.Cells(ListBox1.ListIndex + 6, 121).Value / 1000) '標準報酬額
TextBox1.Value = Int(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 121).Value / 1000) '標準報酬額
'追加 20140513 YB24755 ishikawa
TextBox3.Text = .Cells(ListBox1.List(ListBox1.ListIndex, 4), 126) '国籍
TextBox4.Text = .Cells(ListBox1.List(ListBox1.ListIndex, 4), 127) '在留資格
If .Cells(ListBox1.List(ListBox1.ListIndex, 4), 128) <> "" Then
TextBox5.Value = Year(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 128)) '在留期間
TextBox6.Value = Month(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 128)) '在留期間
TextBox7.Value = Day(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 128)) '在留期間
Else
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
End If
TextBox8.Value = .Cells(ListBox1.List(ListBox1.ListIndex, 4), 129) '前職
'YBNO 28871 ito 20160128 追加 ------------------------------------------------------------------------------
If .Cells(ListBox1.List(ListBox1.ListIndex, 4), 133) <> "" Then '期間自
TextBox9.Value = Format(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 133), "ee")
TextBox10.Value = Month(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 133))
TextBox11.Value = Day(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 133))
Else
TextBox9.Value = ""
TextBox10.Value = ""
TextBox11.Value = ""
End If
If .Cells(ListBox1.List(ListBox1.ListIndex, 4), 134) <> "" Then '期間至
TextBox12.Value = Format(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 134), "ee")
TextBox13.Value = Month(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 134))
TextBox14.Value = Day(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 134))
Else
TextBox12.Value = ""
TextBox13.Value = ""
TextBox14.Value = ""
End If
CheckBox2.Value = .Cells(ListBox1.List(ListBox1.ListIndex, 4), 132) '期間の定め
TextBox16.Value = Val(Left(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 135).Text, 2)) '所定労働時間
TextBox17.Value = Right(.Cells(ListBox1.List(ListBox1.ListIndex, 4), 135).Text, 2)
'YBNO 30074 ito 20160201 所定労働時間未入力の場合は会社情報から
If TextBox16.Value = "" Or TextBox16.Value = 0 Then
TextBox16.Value = Left(Worksheets("DATA").Cells(60, 2).Text, 2)
TextBox17.Value = Right(Worksheets("DATA").Cells(60, 2).Text, 2)
End If
'YBNO 28871 ito 20160128 ここまで --------------------------------------------------------------------------
'------------------------------------------------------------------------------
End With
'YBNO 29507 ito 20160108 201601新様式対応
TextBox19.Value = "" '個人番号クリア
End Sub
Private Sub ListBox2_Click()
ListBox1.ListIndex = Val(ListBox2.Value)
End Sub
Private Sub OptionButton1_Click()
'直近の取得者
ListBox1.Clear
Dim i As Long
Dim n As Integer
n = 0
With Workbooks(MyFile).Worksheets("個人情報")
For i = 6 To .Cells(10000, 2).End(xlUp).Row 'No.の最後の行
If IsDate(.Cells(i, 29).Value) = True And IsDate(.Cells(i, 30).Value) = False Then
If .Cells(i, 29).Value >= Date - 50 Then
ListBox1.AddItem i - 5 '従来の関係から(6行目を1とする)
ListBox1.List(n, 1) = IIf(.Cells(i, 30).Value > 0, "×", " ") '20130101 titti この列を非表示とする
ListBox1.List(n, 2) = .Cells(i, 29).Text '取得日
ListBox1.List(n, 3) = .Cells(i, 5).Value & " " & .Cells(i, 6).Value '氏名
'20081201 kon
ListBox1.List(n, 4) = i
n = n + 1
End If
End If
Next
End With
End Sub
Private Sub OptionButton2_Click()
'すべて
ListBox1.Clear
Dim n As Integer
Dim i As Long
n = 0
With Workbooks(MyFile).Worksheets("個人情報")
For i = 6 To .Cells(10000, 2).End(xlUp).Row 'No.の最後の行
If IsDate(.Cells(i, 29).Value) = True And IsDate(.Cells(i, 30).Value) = False Then
ListBox1.AddItem i - 5 '従来の関係から(6行目を1とする)
ListBox1.List(n, 1) = IIf(.Cells(i, 30).Value > 0, "×", " ")
ListBox1.List(n, 2) = .Cells(i, 29).Text '取得日
ListBox1.List(n, 3) = .Cells(i, 5).Value & " " & .Cells(i, 6).Value '氏名
'20081201 kon
ListBox1.List(n, 4) = i
n = n + 1
End If
Next
End With
End Sub
Private Sub UserForm_Initialize()
MyFile = Worksheets("DATA").Cells(1, 1).Value '読み込まれた台帳ファイル名
OptionButton1.Value = True
On Error Resume Next '前回のデータを反映させるため
ListBox1.ListIndex = Cells(1, 1).Value - 1
On Error GoTo 0
ComboBox1.AddItem "1"
ComboBox1.List(0, 1) = "1 新規"
ComboBox1.AddItem "2"
ComboBox1.List(1, 1) = "2 再取得"
ComboBox1.Value = IIf(Cells(11, 21).Value = "", 2, Cells(11, 21).Value)
ComboBox2.AddItem "1"
ComboBox2.List(0, 1) = "1 新規雇用(学卒)"
ComboBox2.AddItem "2"
ComboBox2.List(1, 1) = "2 新規雇用(その他)"
ComboBox2.AddItem "3"
ComboBox2.List(2, 1) = "3 日雇からの切替"
ComboBox2.AddItem "4"
ComboBox2.List(3, 1) = "4 その他"
ComboBox2.AddItem "8"
ComboBox2.List(4, 1) = "8 出向元への復帰"
ComboBox2.Value = IIf(Cells(21, 4).Value = "", 2, Cells(21, 4).Value)
ComboBox3.AddItem "1"
ComboBox3.List(0, 1) = "1 月給"
ComboBox3.AddItem "2"
ComboBox3.List(1, 1) = "2 週給"
ComboBox3.AddItem "3"
ComboBox3.List(2, 1) = "3 日給"
ComboBox3.AddItem "4"
ComboBox3.List(3, 1) = "4 時間給"
ComboBox3.AddItem "5"
ComboBox3.List(4, 1) = "5 その他"
ComboBox3.Value = IIf(Cells(21, 11).Value = "", 1, Cells(21, 11).Value)
'20090416 kon
ComboBox5.AddItem "1"
ComboBox5.List(0, 1) = "1 日雇"
ComboBox5.AddItem "2"
'20110408 kon
'ComboBox5.List(1, 1) = "2 登録型派遣労働者"
ComboBox5.List(1, 1) = "2 派遣"
ComboBox5.AddItem "3"
'20110408 kon
'ComboBox5.List(2, 1) = "3 短時間就労者"
ComboBox5.List(2, 1) = "3 パートタイム"
ComboBox5.AddItem "4"
ComboBox5.List(3, 1) = "4 有期契約労働者" '20090409雅也修正
ComboBox5.AddItem "5"
ComboBox5.List(4, 1) = "5 季節的雇用"
'20110408 kon
ComboBox5.AddItem "6"
ComboBox5.List(5, 1) = "6 船員"
ComboBox5.AddItem "7"
'20110408 kon
'ComboBox5.List(5, 1) = "7 その他"
ComboBox5.List(6, 1) = "7 その他"
ComboBox5.Value = IIf(Cells(21, 21).Value = "", 7, Cells(21, 21).Value)
'YBNO 29507 ito 20151120
'YB30304 清水 20160217
If Cells(35, 30).Value = 1 Then
ComboBox4.AddItem "01"
ComboBox4.List(0, 1) = "01 管理的職業"
ComboBox4.AddItem "02"
ComboBox4.List(1, 1) = "02 専門的・技術的職業"
ComboBox4.AddItem "03"
ComboBox4.List(2, 1) = "03 事務的職業"
ComboBox4.AddItem "04"
ComboBox4.List(3, 1) = "04 販売の職業"
ComboBox4.AddItem "05"
ComboBox4.List(4, 1) = "05 サービスの職業"
ComboBox4.AddItem "06"
ComboBox4.List(5, 1) = "06 保安の職業"
ComboBox4.AddItem "07"
ComboBox4.List(6, 1) = "07 農林漁業の職業"
ComboBox4.AddItem "08"
ComboBox4.List(7, 1) = "08 生産工程の職業"
ComboBox4.AddItem "09"
ComboBox4.List(8, 1) = "09 輸送・機械運転の職業"
ComboBox4.AddItem "10"
ComboBox4.List(9, 1) = "10 建設・採掘の職業"
ComboBox4.AddItem "11"
ComboBox4.List(10, 1) = "11 運搬・清掃・包装等の職業"
'YBNO 30337 ito 20160219
'ComboBox4.Value = IIf(Cells(21, 24).Value = "", "01", Cells(21, 24).Value)
ComboBox4.Value = "01"
Else
ComboBox4.AddItem "1"
ComboBox4.List(0, 1) = "1 専門的技術的職業"
ComboBox4.AddItem "2"
ComboBox4.List(1, 1) = "2 管理的職業"
ComboBox4.AddItem "3"
ComboBox4.List(2, 1) = "3 事務的職業"
ComboBox4.AddItem "4"
ComboBox4.List(3, 1) = "4 販売の職業"
ComboBox4.AddItem "5"
ComboBox4.List(4, 1) = "5 サービスの職業"
ComboBox4.AddItem "6"
ComboBox4.List(5, 1) = "6 保安の職業"
ComboBox4.AddItem "7"
ComboBox4.List(6, 1) = "7 農林漁業の職業"
ComboBox4.AddItem "8"
ComboBox4.List(7, 1) = "8 運輸通信の職業"
ComboBox4.AddItem "9"
ComboBox4.List(8, 1) = "9 生産工程、労務の職業"
'YBNO 30337 ito 20160219
'ComboBox4.Value = IIf(Cells(21, 25).Value = "", 9, Cells(21, 25).Value)
ComboBox4.Value = "1"
End If
'ComboBox6.AddItem "有"
'ComboBox6.AddItem "無"
ComboBox6.AddItem "1"
ComboBox6.List(0, 1) = "1 有"
ComboBox6.AddItem "2"
ComboBox6.List(1, 1) = "2 無"
'YBNO 29507 ito 20151120 追加
ComboBox7.AddItem "1"
ComboBox7.List(0, 1) = "1 安定所紹介"
ComboBox7.AddItem "2"
ComboBox7.List(1, 1) = "2 自己就職"
ComboBox7.AddItem "3"
ComboBox7.List(2, 1) = "3 民間紹介"
ComboBox7.AddItem "4"
ComboBox7.List(3, 1) = "4 把握していない"
ComboBox7.Value = IIf(Cells(21, 27).Value = "", 1, Cells(21, 27).Value)
ComboBox8.AddItem "1"
ComboBox8.List(0, 1) = "1 主として当該事業所で就労する場合"
ComboBox8.AddItem "2"
ComboBox8.List(1, 1) = "2 1に該当しない場合"
'H20080604 masaya
'YBNO 29507 ito 20151120
'TextBox3.Value = Cells(28, 22).Value
'TextBox4.Value = Cells(29, 22).Value
'TextBox5.Value = Cells(30, 22).Value
'TextBox6.Value = Cells(30, 25).Value
'TextBox7.Value = Cells(30, 27).Value
'ComboBox6.Value = Cells(31, 24).Value
TextBox3.Text = Cells(29, 4).Value
TextBox4.Text = Cells(29, 11).Value
TextBox5.Value = Cells(29, 16).Value & Cells(29, 17).Value & Cells(29, 18).Value & Cells(29, 19).Value
TextBox6.Value = Cells(29, 20).Value & Cells(29, 21).Value
TextBox7.Value = Cells(29, 22).Value & Cells(29, 23).Value
ComboBox6.Value = Cells(29, 25).Value
ComboBox8.Value = Cells(29, 27).Value
If Cells(32, 27).Value = "" Then
CheckBox4.Value = False
Else
CheckBox4.Value = True
End If
'YBNO 29507 ito 20160105
'TextBox8.Value = Cells(33, 19).Value
TextBox8.Value = Cells(25, 20).Value '備考
'20081022 kon
TextBox9.Value = Cells(28, 30).Value
TextBox10.Value = Cells(28, 31).Value
TextBox11.Value = Cells(28, 32).Value
TextBox12.Value = Cells(29, 30).Value
TextBox13.Value = Cells(29, 31).Value
TextBox14.Value = Cells(29, 32).Value
'契約更新条項の有無
If Cells(30, 30).Value = True Then
CheckBox5.Value = True
ElseIf Cells(30, 30).Value = False Then
CheckBox5.Value = False
End If
'YBNO 29507 ito 20151120 コメントに
''半年年以上使用する見込みの有無
'If Cells(30, 31).Value = True Then
' CheckBox6.Value = True
'ElseIf Cells(30, 31).Value = False Then
' CheckBox6.Value = False
'End If
''20100301masa
''半年年以上使用する見込みの有無
'If Cells(31, 31).Value = True Then
' CheckBox9.Value = True
'ElseIf Cells(31, 31).Value = False Then
' CheckBox9.Value = False
'End If
CheckBox7.Value = Cells(19, 32).Value '予備の事業所番号
TextBox1.Value = Cells(21, 30).Value '賃金
CheckBox2.Value = IIf(Cells(23, 30).Value = "", True, Cells(23, 30).Value) '契約期間の定め
CheckBox3.Value = IIf(Cells(31, 30).Value = "", True, Cells(31, 30).Value) '事務組合
TextBox15.Value = Worksheets("DATA").Cells(38, 2).Value
'YBNO 28871 ito 20160128 コメントに
'TextBox16.Value = Left(Cells(23, 31).Value, 2)
'TextBox17.Value = Right(Cells(23, 31).Value, 2)
'20081202 kon
If CheckBox2.Value = True Then
CheckBox5.Enabled = True
'YBNO 29507 ito 20151124
'CheckBox6.Enabled = True
Frame4.Enabled = True
Label22.Enabled = True
Else
CheckBox5.Enabled = False
CheckBox5.Value = False
'YBNO 29507 ito 20151124
'CheckBox6.Enabled = False
'CheckBox6.Value = False
''20100301masaya
'CheckBox9.Enabled = False
'CheckBox9.Value = False
Frame4.Enabled = False
Label22.Enabled = False
End If
'''YBNO 18519
Dim NowDate As Date
NowDate = Now
If Cells(35, 31).Value <> vbNullString And IsNumeric(Cells(35, 31).Value) Then
Me.txtApplyYear.Text = Cells(35, 31).Value
Else
Me.txtApplyYear.Text = Year(NowDate) - 1988
End If
If Cells(35, 32).Value <> vbNullString And IsNumeric(Cells(35, 32).Value) Then
Me.txtApplyMonth.Text = Cells(35, 32).Value
Else
Me.txtApplyMonth.Text = Month(NowDate)
End If
If Cells(35, 33).Value <> vbNullString And IsNumeric(Cells(35, 33).Value) Then
Me.txtApplyDay.Text = Cells(35, 33).Value
Else
Me.txtApplyDay.Text = Day(NowDate)
End If
'''END YBNO 18519
CreateComboBox TextBox3, Application.Run("DaAddin.xla!NationalityList") ' NationalityList '国籍リストを作る
CreateComboBox TextBox4, Application.Run("DaAddin.xla!ResidenceList") ' ResidenceList '在留資格リストを作る
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub CreateComboBox(ByRef cbo As MSForms.ComboBox, ByRef col As Collection)
Dim item As Variant
cbo.Clear
For Each item In col
cbo.AddItem Split(item, ",")(0)
cbo.List(cbo.ListCount - 1, 1) = Split(item, ",")(1)
Next
End Sub
Attribute VB_Name = "Module1"
'*************************************************************************
' 修整履歴
' 代行印が2007でエラーになるため 20070209 kon
' 直近の取得者の時に賃金月額が正しく表示しないため 20081201 kon
' 期間の定めのない場合は契約更新条項の有無・1年以上使用する見込みの有無は空に 20081202 kon
' 派遣とパートが逆だった 20090416 kon
' 用紙変更(2010.6)のため 20100830 kon
' 用紙追加(2011.01)のため 20110408 kon
' 社会保険労務士記載欄を初めから提出代行者を表示するように変更 20110512 kon
' 事業所名・ハローワーク名を印刷するしないを切り替え 20110512 kon
'*************************************************************************
Option Explicit
Public Const PROC_NAME As String = "雇用保険資格取得届"
Public Const AAA As String = "取得関係"
Public Const PDF_EXE As String = "雇用保険役所用紙.exe" '20110408 kon
'20110408 kon
Public pFg As Boolean
'20110512 kon
Public hFg As Boolean
Public jFg As Boolean
Public cFg As Boolean
Public cDat(3) As String
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
'---
Private 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
'20110927 余白設定
Public Tmargin As Double
Public Lmargin As Double
Public hName As String
Public huki As Integer
'関数
Sub OpenFile(fName As String)
'関連付いたアプリケーションで立ち上げる
Call ShellExecute(0, "open", ThisWorkbook.Path & "\" & fName, vbNullString, vbNullString, 1)
End Sub
Sub OpenManual()
Application.Run "DaAddin.xla!OpenManual"
End Sub
Sub A保存()
Worksheets("DATA").Range("A1,A3:B74,G20:I26").ClearContents
Sheets("雇用保険取得届").Select
Cells(26, 21).Value = ""
Range("U11,D21,K21,U21,Y21,AD21").ClearContents
Range("A1").ClearContents '現在データをクリア
Cells(1, 1).Select
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayWorkbookTabs = False
Application.EnableEvents = False
ThisWorkbook.Save
Application.EnableEvents = True
End Sub
Sub 印刷()
If MsgBox("プリンタの準備はいいですか?", 1 + 32, "印刷") <> 1 Then Exit Sub
DoEvents
ActiveSheet.PrintOut
DoEvents
End Sub
Sub 戻る()
'ThisWorkbook.Close False
'20100903 kon
ThisWorkbook.Activate
Application.Run "DaAddin.xla!閉じる"
End Sub
Sub 選択へ()
選択.Show
End Sub
Sub 初期処理()
Sheets("雇用保険取得届").Select
選択へ
End Sub
Sub 雇用保険取得届()
Sheets("雇用保険取得届").Select
End Sub
Sub Da保存へ()
Dim MyName As String
If ActiveSheet.Name = "雇用保険取得届" Then
MyName = Cells(13, 4).Value & " 作成日" & Format(Date, "geemmdd")
ElseIf ActiveSheet.Name = "労働条件通知" Then
MyName = Cells(7, 3).Value & " 作成日" & Format(Date, "geemmdd")
End If
Open Workbooks("DaMenu.xls").Path & "\HozonName.dat" For Output As #1
Write #1, MyName
Close #1
'YBNO 29734 ito 20151216 保存時マイナンバークリア
'Application.Run "DaAddin.xla!Da保存へ"
If ActiveSheet.Name = "雇用保険取得届" Then
Application.Run "DaAddin.xla!Da保存へ", "D9:O9,AD9"
Else
Application.Run "DaAddin.xla!Da保存へ", vbNullString
End If
End Sub
Sub 保存読込へ()
Application.Run "DaAddin.xla!Da保存読込へ"
End Sub
Sub 設定保存()
If MsgBox("この設定を保存しますか?", 1 + 32, "保存") <> 1 Then Exit Sub
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Application.EnableEvents = False
ThisWorkbook.Save
Application.EnableEvents = True
End Sub
Sub 定型印の読込()
Application.ScreenUpdating = False
With Workbooks("DaMenu.xls").Worksheets("標準報酬月額")
If IsError(.Cells(164, 14).Value) Then
MsgBox "事務所データの電話番号が正しく入力されていませんので、作成することができません。(半角で0999-99-9999形式)", 16, AAA
Exit Sub
End If
.Range("K162:N164").CopyPicture Appearance:=xlScreen, Format:=xlPicture
End With
Cells(74, 10).Select
ActiveSheet.Paste
'20070209 kon
' Selection.Locked = False
Application.ScreenUpdating = True
MsgBox "ドラッグして所定の位置に貼り付けてください。" & vbCr & _
"この定型印を貼り付けた状態でこのシートを保存するには「原本保存」をおこなってください。", 64, AAA
'20070209 kon
ActiveSheet.Unprotect
End Sub
Sub 労働条件通知()
Sheets("労働条件通知").Select
End Sub
Sub 会社Fへ()
Application.Run "DaAddin.xla!会社Fへ"
End Sub
Sub 給与Fへ()
Application.Run "DaAddin.xla!給与Fへ"
End Sub
Sub 個人Fへ()
Application.Run "DaAddin.xla!個人Fへ"
End Sub
Sub 保護解除()
ActiveSheet.Unprotect
ActiveWindow.DisplayHeadings = True
MsgBox "解除しました。", 64, AAA
End Sub
Sub 印刷2へ()
Dim Yousi As String
Dim Button As String
'YBNO 29507 ito 20151124 旧様式廃止
''20100830 kon
''If Cells(35, 30).Value = 1 Then Yousi = "雇用保険資格取得届印刷H2202.xls"
''If Cells(35, 30).Value = 2 Then Yousi = "雇用保険資格取得届印刷.xls"
'If Cells(35, 30).Value = 1 Then Yousi = "雇用保険資格取得届印刷H2206.xls"
'If Cells(35, 30).Value = 2 Then
'Yousi = "雇用保険資格取得届印刷H2202.xls"
'Button = "Zu9"
'End If
''B5用紙廃止 20110408 kon
''If Cells(35, 30).Value = 3 Then
''Yousi = "雇用保険資格取得届印刷.xls"
''Button = "Zu8"
''End If
' '20110408 kon
'' Dim fnam As String
' If Cells(35, 30).Value = 3 Then
''20130305 kon 2013
'' frmPrint.Show
' frmPrint.Show 0
'
'''' YBNO21974 この部分をCreatePDFにする
'' If cFg = True Then
''' MsgBox "印刷はキャンセルされました。", vbInformation, "資格取得届印刷"
'' Exit Sub
'' End If
''
'' If Len(Cells(13, 30).Value) > 20 Then
'' MsgBox "被保険者氏名カナが表示範囲を超えています。20文字まで表示します。(半角カナ20文字まで)", vbInformation, "資格取得届印刷"
''' Exit Sub
'' End If
'' If Len(Cells(14, 31).Value) > 20 Then
'' MsgBox "変更後の氏名カナが表示範囲を超えています。20文字まで表示します。(半角カナ20文字まで)", vbInformation, "資格取得届印刷"
''' Exit Sub
'' End If
''
''
'' fnam = ThisWorkbook.Path & "\pdf\雇用資格取得\" & Trim(Cells(13, 4).Value) & Format(Now(), "YYYYMMDDHHSS") & ".TDF"
'' If Dir(ThisWorkbook.Path & "\pdf", vbDirectory) = "" Then
'' MkDir (ThisWorkbook.Path & "\pdf")
'' End If
'' If Dir(ThisWorkbook.Path & "\pdf\雇用資格取得", vbDirectory) = "" Then
'' MkDir (ThisWorkbook.Path & "\pdf\雇用資格取得")
'' End If
'' '20110511 kon
''
'' 'pdfファイルを削除する
''' On Error Resume Next
''' Kill ThisWorkbook.Path & "\pdf\雇用資格取得\" & "*.pdf"
''' On Error GoTo 0
''
''
'' Call pdf作成(fnam, pFg)
'' Dim ShellString As String
'' Dim param As String
'' param = 1
''
''
'' ShellString = """" & PathCombine(ThisWorkbook.Path, "雇用保険役所用紙.exe") & """ """ & PathCombine(GetProgramFolder, "雇用資格取得") & """ """ & fnam & """ """ & param & """ """ & pFg & """ """ & Tmargin & """ """ & Lmargin & """"
''
'' ExecCmd ShellString
''
''
'' Application.ScreenUpdating = True
'' Exit Sub
'''' END YBNO 21794
' Else
'
'
' Dim wb As Workbook
' For Each wb In Workbooks
' If wb.Name = Yousi Then
' wb.Activate
' Exit Sub
' End If
' Next
'
' Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Yousi
'
' '20101028masa 2010問題 閉じるボタンを張り付ける
' Application.ScreenUpdating = False
' If Workbooks(Yousi).BuiltinDocumentProperties("Keywords").Value <> 2010 Then
' Workbooks.Open Workbooks("DaMenu.xls").Path & "\閉じるボタン.xls"
' Workbooks("閉じるボタン.xls").Worksheets("Button").Shapes(Button).Copy
' Workbooks(Yousi).Activate
' Range("A1").Select
' ActiveSheet.Paste
' ActiveSheet.Shapes(Button).Top = 17
' ActiveSheet.Shapes(Button).Left = 17
' Range("A1").Select
' Workbooks(Yousi).BuiltinDocumentProperties("Keywords").Value = 2010
' Application.EnableEvents = False
' ActiveWorkbook.Save
' Application.EnableEvents = True
' Workbooks("閉じるボタン.xls").Close False
' End If
' Application.ScreenUpdating = True
' End If
frmPrint.Show 0
…
|
|||
Open this report in the interactive analyzer, or submit your own file for analysis.