MALICIOUS
102
Risk Score
Malware Insights
MITRE ATT&CK
T1059.005 Visual Basic
T1566.001 Spearphishing Attachment
The file is an Excel spreadsheet containing VBA macros, indicated by the 'OLE_VBA_MACROS' heuristic. The document body contains Japanese text related to employment benefits such as childcare and family care leave, suggesting a social engineering lure. The presence of 'CreateProcess' and 'ShellExecute' API references points towards the execution of external processes, a common behavior for malicious macros. While the embedded URL is confirmed benign, the overall structure and heuristic firings suggest a malicious intent, likely to download and execute a secondary payload.
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) | 1700147 bytes |
SHA-256: c75c7bedaaa6a45019551f1aabe23439165c6f018de7ede857f91ca6325c4b2f |
|||
Preview scriptFirst 1,000 lines of the extracted script
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 = "育児受給資格"
Attribute VB_Base = "0{1642BEDC-2F73-4A40-B6E0-755E027D045F}{FE4D95E1-8EBF-43EF-851A-859BD8D5775B}"
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 行 As Integer
Dim MyFile As String
Private Sub CommandButton1_Click()
If TextBox12.Value = "" Then
MsgBox "検索する文字列を入力してください。", 16, AA
TextBox12.SetFocus
Exit Sub
End If
If ListBox1.ListCount = 0 Then Exit Sub
If CommandButton1.Caption = "すべて表示" Then
ListBox2.Visible = False
CommandButton1.Caption = "検索"
TextBox12.Value = ""
TextBox12.SetFocus
Exit Sub
End If
ListBox2.Clear
n = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.List(i, 1) Like "*" & TextBox12.Value & "*" Then
ListBox2.AddItem ListBox1.List(i, 0)
ListBox2.List(n, 1) = ListBox1.List(i, 1)
ListBox2.List(n, 2) = ListBox1.List(i, 2)
n = n + 1
End If
Next
If n = 0 Then '見つからなかったら
MsgBox "被保険者名に「" & TextBox12.Value & "」を含む氏名はみつかりませんでした。", 16, AA
TextBox12.Value = ""
TextBox12.SetFocus
Else
ListBox2.Visible = True
ListBox2.ListIndex = 0 '最初の人を選択状態にする
CommandButton1.Caption = "すべて表示"
End If
End Sub
Private Sub CommandButton2_Click()
Dim wb As Workbook
Dim flag As Boolean
Dim fName As String
' If MsgBox("プリンタの準備はいいですか？", 1 + 32, "印刷") <> 1 Then Exit Sub
'20110818 kon
' 登録
'20140930 kon
' If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 Then
'YBNO 29511 ito 20151214 201601新様式対応
'If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 Or ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 4 Then
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 Or ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 4 Or ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 5 Then
登録1340
Else
登録
End If
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 1 Then
If MsgBox("プリンタの準備はいいですか？", 1 + 32, "印刷") <> 1 Then Exit Sub
fName = "育児休業受給資格確認票印刷.xls"
ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 2 Then
If MsgBox("プリンタの準備はいいですか？", 1 + 32, "印刷") <> 1 Then Exit Sub
fName = "H21育児休業受給資格確認票印刷.xls"
'20140930 kon
' ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 Then
'YBNO 29511 ito 20151214 201601新様式対応
'ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 Or ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 4 Then
ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 Or ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 4 Or ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 5 Then
'PDF印刷
' 登録1340
frmPrint.Show
If cFg = True Then
Exit Sub
End If
' If Len(Cells(11, 30).Value) > 20 Then
' MsgBox "被保険者氏名カナが表示範囲を超えています。20文字まで表示します。（半角ｶﾅ20文字まで）", vbInformation, "資格取得届印刷"
' End If
fName = ThisWorkbook.Path & "\pdf\育児介護給付\" & Trim(Cells(149, 62).Value) & Format(Now(), "YYYYMMDDHHMMSS") & ".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
Call pdf作成(fName, pFg)
Dim ShellString As String
Dim param As String
'20140930 kon
' param = 1
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 Then
param = 1
ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 4 Then
param = 5
'YBNO 29511 ito 20151214 201601新様式対応 追加 ---------------------------
ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 5 Then
param = 9
'YBNO 29511 ito 20151214 ここまで -----------------------------------------
End If
ShellString = """" & PathCombine(ThisWorkbook.Path, "雇用保険関係.exe") & """ """ & PathCombine(GetProgramFolder, "育児介護給付") & """ """ & fName & """ """ & param & """ """ & pFg & """ """ & Tmargin & """ """ & Lmargin & """"
ExecCmd ShellString
Exit Sub
End If
flag = False
For Each wb In Workbooks
If wb.Name = fName Then
flag = True
Exit For
End If
Next wb
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If flag = False Then
Workbooks.Open ThisWorkbook.Path & "\" & fName
End If
' Range("A2:CO179").Value = ThisWorkbook.Worksheets(fName).Range("A2:CO179").Value2
Worksheets("新確認票初回").PrintOut
Workbooks(fName).Close
ThisWorkbook.Activate
'Sheets("MENU").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton3_Click()
Dim wb As Workbook
Dim flag As Boolean
Dim fName As String
' If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 1 Then
fName = "育児休業受給資格確認票印刷.xls"
' Else
' fName = "H21育児休業受給資格確認票印刷.xls"
' End If
Application.ScreenUpdating = False
登録
flag = False
For Each wb In Workbooks
If wb.Name = fName Then
flag = True
Exit For
End If
Next wb
If flag = False Then
Workbooks.Open ThisWorkbook.Path & "\" & fName
End If
Windows(fName).Activate
Sheets("新確認票初回").Select
' Range("A2:CO179").Value = ThisWorkbook.Worksheets("新確認票初回").Range("A2:CO179").Value2
Cells(1, 1).Select
Windows(fName).Activate
Sheets("新確認票初回").Select
ActiveSheet.Unprotect
ActiveWindow.DisplayHeadings = True
Application.ScreenUpdating = True
Unload Me
End Sub
Private Sub CommandButton4_Click()
Dim iCnt As Integer
If MsgBox("このデータをクリアしてもいいですか？", 1 + 32, "クリア") <> 1 Then Exit Sub
For i = 1 To 55
If i <> 25 And i <> 26 And i <> 27 And i <> 39 And i <> 40 And i <> 29 And i <> 18 And i <> 19 And i <> 37 Then
Controls("Text" & i).Value = ""
End If
Next
For i = 1 To 3
Controls("cmb" & i).Value = ""
Next
TextBox13.Value = ""
For i = 22 To 25
Controls("TextBox" & i).Value = ""
Next
For i = 14 To 17
Controls("TextBox" & i).Value = ""
Next
'20140930 kon
'YBNO 29511 ito 20160210
'For i = 26 To 28
For i = 26 To 29
Controls("TextBox" & i).Value = ""
Next
Select Case ActiveSheet.Name
Case "新確認票初回"
'金融機関
'フリガナ
Cells(143, 29).Value = ""
Cells(146, 29).Value = ""
'口座番号
Cells(150, 33).Value = ""
'金融機関コード
For iCnt = 1 To 4
Cells(146, 56 + iCnt * 4).Value = ""
Next iCnt
'店舗コード
For iCnt = 1 To 3
Cells(146, 72 + iCnt * 4).Value = ""
Next iCnt
'YBNO 29511 ito 20151214 201601新様式対応
'Case "1340確認票"
Case "1340確認票", "確認票201601"
'金融機関
'フリガナ
Cells(157, 29).Value = ""
Cells(160, 29).Value = ""
'口座番号
Cells(164, 33).Value = ""
'金融機関コード
For iCnt = 1 To 4
Cells(160, 56 + iCnt * 4).Value = ""
Next iCnt
'店舗コード
For iCnt = 1 To 3
Cells(160, 72 + iCnt * 4).Value = ""
Next iCnt
End Select
End Sub
Private Sub CommandButton5_Click()
If Text24.Value = "" Then
MsgBox "保存するデータが有りません。", vbInformation, "育児介護給付"
Exit Sub
End If
'20110818 kon
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 1 Then
登録
'保存F.TextBox1.Value = Text18.Value & " " & Text24.Value
'20110818 KON
保存F.Caption = "新育児休業給付受給資格確認票の保存"
ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 Then
保存F.Caption = "2011育児休業給付受給資格確認票の保存"
保存F.TextBox1.Value = Text24.Value
登録1340
'20140930 kon
Else
'登録1340
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 4 Then
保存F.Caption = "2014育児休業給付受給資格確認票の保存"
保存F.TextBox1.Value = Text24.Value
登録1340
End If
'YBNO 29511 ito 20151214 201601新様式対応 追加 ---------------------------
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 5 Then
保存F.Caption = "2016育児休業給付受給資格確認票の保存"
保存F.TextBox1.Value = Text24.Value
登録1340
End If
'YBNO 29511 ito 20151214 ここまで -----------------------------------------
End If
'20110818 KON
' 保存F.Caption = "新育児休業給付受給資格確認票の保存"
保存F.Show
End Sub
Private Sub CommandButton6_Click()
'20110818 kon
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 1 Then
フォーム読込.Caption = "新育児休業給付受給資格確認票の読込"
'20140926 kon
ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 4 Then
フォーム読込.Caption = "2014育児休業給付受給資格確認票の読込"
'YBNO 29511 ito 20151214 201601新様式対応 追加 ---------------------------
ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 5 Then
フォーム読込.Caption = "2016育児休業給付受給資格確認票の読込"
'YBNO 29511 ito 20151214 ここまで -----------------------------------------
Else
フォーム読込.Caption = "2011育児休業給付受給資格確認票の読込"
End If
' フォーム読込.Caption = "新育児休業給付受給資格確認票の読込"
フォーム読込.Show
Unload Me
Call 育児受給資格へ 'YBNO 30033 ito 20160122
End Sub
Private Sub CommandButton7_Click()
フォーム払渡銀行.Show
End Sub
Private Sub CommandButton8_Click()
フォーム事業主.Show
End Sub
'YBNO 29971 ito 20160121
Private Sub CommandButton9_Click()
Dim id As String
If Text24.Value <> "" Then 'YBNO 30270 ito 20160212
If ListBox1.ListIndex <> -1 Then
If Application.Run("DaAddin.xla!MNMode", True, False) Then 'リスト選択時
id = Workbooks(MyFile).Worksheets("個人情報").Cells(ListBox1.List(ListBox1.ListIndex, 0), 200).Value
TextBox29.Text = Application.Run("DaAddin.xla!GetMyno", id, Workbooks(MyFile).Worksheets("会社情報"), "育児介護給付")
End If
'YBNO 30033 ito 20160122 追加 ---------------------------------------
Else '保存データ読込時
If ActiveSheet.Cells(10, 1).Value <> "" Then
If Application.Run("DaAddin.xla!MNMode", True, False) Then
id = ActiveSheet.Cells(10, 1).Value
TextBox29.Text = Application.Run("DaAddin.xla!GetMyno", id, Workbooks(MyFile).Worksheets("会社情報"), "育児介護給付")
End If
End If
'YBNO 30033 ito 20160121 ここまで -----------------------------------
End If 'YBNO 30270 ito 20160212
End If
End Sub
Private Sub ListBox1_Click()
Dim iCnt(2) As Integer
If ListBox1.ListIndex = -1 Then Exit Sub
For i = 1 To 45
'20140926 kon 就業時間追加
' If i <> 9 And i <> 25 And i <> 26 And i <> 27 And i <> 39 And i <> 40 And i <> 18 And i <> 19 And i <> 29 Then
If i <> 9 And i <> 25 And i <> 26 And i <> 27 And i <> 39 And i <> 40 And i <> 18 And i <> 19 And i <> 29 And i <> 37 Then
Controls("Text" & i).Value = ""
End If
Next
'20140930 kon
For i = 14 To 28
If i <> 18 And i <> 19 And i <> 20 And i <> 21 Then
Controls("TextBox" & i).Value = ""
End If
Next
With Workbooks(MyFile).Worksheets("個人情報")
行 = Val(ListBox1.Value)
Text1.Value = Mid(.Cells(行, 26).Value, 1, 4) '被保険者番号
Text2.Value = Mid(.Cells(行, 26).Value, 6, 6) '被保険者番号
Text3.Value = Mid(.Cells(行, 26).Value, 13, 1) '被保険者番号
Text4.Value = Format(.Cells(行, 29).Value, "eemmdd") '取得日
'20110307 YBNO 4556
Text42.Value = IIf(.Cells(行, 29).Value = "", "", IIf(Left(.Cells(行, 29).Text, 1) = "S", 3, 4)) '取得日
'END 20110307 YBNO 4556
Text46.Value = Mid(.Cells(行, 34).Value, 1, 3) '〒
Text11.Value = Mid(.Cells(行, 34).Value, 5, 4) '〒
'20110818 kon
' Text12.Value = Mid(.Cells(行, 36).Value, 1, 27) '住所ｶﾅ
' Text13.Value = Mid(.Cells(行, 36).Value, 28, 27) '住所ｶﾅ
If ActiveSheet.Name = "新確認票初回" Then
Text12.Value = Mid(.Cells(行, 36).Value, 1, 27) '住所ｶﾅ
Text13.Value = Mid(.Cells(行, 36).Value, 28, 27) '住所ｶﾅ
Else
Text12.Value = Mid(.Cells(行, 35).Value, 1, 20) '住所漢字
Text13.Value = Mid(.Cells(行, 35).Value, 21, 20) '住所漢字
TextBox13.Value = Mid(.Cells(行, 35).Value, 41, 20) '住所漢字
End If
If .Cells(行, 33) <> "" Then
'---------------------------------------------
Call TEL(.Cells(行, 33))
'20110203masa 市外局番が登録されていないとエラーでおちる Ｅ3879
' iCnt(0) = InStr(.Cells(行, 33), "-")
' iCnt(1) = InStrRev(.Cells(行, 33), "-")
' Text14.Value = Left(.Cells(行, 33).Value, iCnt(0) - 1) 'tel
' Text15.Value = Mid(.Cells(行, 33).Value, iCnt(0) + 1, iCnt(1) - iCnt(0) - 1) 'tel
' Text16.Value = Right(.Cells(行, 33).Value, Len(.Cells(行, 33).Value) - iCnt(1)) 'tel
'---------------------------------------------
End If
Text23.Value = .Cells(行, 7).Value & " " & .Cells(行, 8).Value '氏名カナ
Text24.Value = ListBox1.Text '氏名
Text30.Value = .Cells(行, 2).Value 'No
Cells(200, 1).Value = .Cells(行, 35).Value '月額証明書用の住所
End With
With Workbooks(MyFile).Worksheets("会社情報")
Text5.Value = Mid(.Cells(36, 2).Value, 1, 4) '事業所番号
Text6.Value = Mid(.Cells(36, 2).Value, 6, 6) '事業所番号
Text7.Value = Mid(.Cells(36, 2).Value, 13, 1) '事業所番号
Text9.Value = .Cells(33, 2).Value '賃金締切日
cmb3.Value = .Cells(34, 2).Value '支払
Text52.Value = .Cells(35, 2).Value '支払日
End With
'YBNO 29511 ito 20151214 201601新様式対応
TextBox29.Value = "" '個人番号クリア
End Sub
Private Sub TEL(Denwa As String)
Dim j As Integer
Dim k As Integer
Dim l As Integer
j = 0
k = 0
For l = 1 To Len(Denwa)
If Mid(Denwa, l, 1) = "-" Then
If j = 0 Then
j = l
Else
k = l
End If
End If
Next
If j = 0 Then 'ＴＥＬ１
Text14.Value = Denwa
Exit Sub
Else
Text14.Value = Mid(Denwa, 1, j - 1)
End If
If k = 0 Then 'ＴＥＬ2
Text15.Value = Mid(Denwa, j + 1, Len(Denwa) - j)
Exit Sub
Else
Text15.Value = Mid(Denwa, j + 1, k - j - 1)
End If
Text16.Value = Mid(Denwa, k + 1, Len(Denwa) - k) 'ＴＥＬ3
End Sub
Private Sub ListBox2_Click()
ListBox1.Value = ListBox2.Value
End Sub
Private Sub Command実行_Click()
'YBNO 29511 ito 20151214 201601新様式対応
'If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 1 Then '201101様式だったら
' 登録
'Else
' 登録1340
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 5 Then
If TextBox29.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
登録1340
'個人番号があるときにログを作る
'---------------------------------------------
If TextBox29.Text <> vbNullString And Application.Run("DaAddin.xla!MNMode", True, False) Then
Dim guid As String
guid = ThisWorkbook.Worksheets("育児休業201601").Cells(10, 1).Value
Dim ComAccount As String
ComAccount = Application.Run("業務日誌.xlam!GetCompanyData", Workbooks(MyFile))
Application.Run "DaAddin.xla!ProcLogging", ComAccount, PROC_NAME, "データ作成", vbNullString, guid, Text24.Value, "成功"
End If
'---------------------------------------------
Else
登録1340
End If
MsgBox "登録しました", 64, AA
End Sub
Private Sub 登録()
Dim iCnt As Integer
Dim LCnt As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ThisWorkbook.Worksheets("新確認票初回")
'被保険者番号
For iCnt = 1 To 4
.Cells(10, 22 + iCnt * 3).Value = Mid(Format(Text1.Value, "0000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 6
.Cells(10, 37 + iCnt * 3).Value = Mid(Format(Text2.Value, "000000"), iCnt, 1)
Next iCnt
.Cells(10, 61).Value = Text3.Value
'資格取得年月日
.Cells(10, 69).Value = Text42.Value
For iCnt = 1 To 6
.Cells(10, 72 + iCnt * 3).Value = Mid(Format(Text4.Value, "000000"), iCnt, 1)
Next iCnt
'事業所番号
For iCnt = 1 To 4
.Cells(17, 5 + iCnt * 3).Value = Mid(Format(Text5.Value, "0000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 6
.Cells(17, 20 + iCnt * 3).Value = Mid(Format(Text6.Value, "000000"), iCnt, 1)
Next iCnt
.Cells(17, 44).Value = Text7.Value
'育児休業開始年月日
For iCnt = 1 To 6
.Cells(25, 8 + iCnt * 3).Value = Mid(Format(Text8.Value, "000000"), iCnt, 1)
Next iCnt
'出産年月日
For iCnt = 1 To 6
.Cells(25, 38 + iCnt * 3).Value = Mid(Format(Text10.Value, "000000"), iCnt, 1)
Next iCnt
'被保険者の郵便番号
.Cells(25, 63).Value = Mid(Format(Text46.Value, "000"), 1, 1)
.Cells(25, 66).Value = Mid(Format(Text46.Value, "000"), 2, 1)
.Cells(25, 69).Value = Mid(Format(Text46.Value, "000"), 3, 1)
.Cells(25, 75).Value = Mid(Format(Text11.Value, "0000"), 1, 1)
.Cells(25, 78).Value = Mid(Format(Text11.Value, "0000"), 2, 1)
.Cells(25, 81).Value = Mid(Format(Text11.Value, "0000"), 3, 1)
.Cells(25, 84).Value = Mid(Format(Text11.Value, "0000"), 4, 1)
'被保険者の住所
For iCnt = 1 To 27
.Cells(33, 5 + iCnt * 3).Value = Mid(Text12.Value, iCnt, 1)
Next iCnt
For iCnt = 1 To 27
.Cells(41, 5 + iCnt * 3).Value = Mid(Text13.Value, iCnt, 1)
Next iCnt
'電話番号
For iCnt = 1 To 5
.Cells(49, 5 + iCnt * 3).Value = Mid(Text14.Value, iCnt, 1)
Next iCnt
For iCnt = 1 To 5
.Cells(49, 23 + iCnt * 3).Value = Mid(Text15.Value, iCnt, 1)
Next iCnt
For iCnt = 1 To 5
.Cells(49, 41 + iCnt * 3).Value = Mid(Text16.Value, iCnt, 1)
Next iCnt
'支給単位1
For iCnt = 1 To 6
.Cells(58, 8 + iCnt * 3).Value = Mid(Format(Text31.Value, "000000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 4
.Cells(58, 29 + iCnt * 3).Value = Mid(Format(Text32.Value, "0000"), iCnt, 1)
Next iCnt
LCnt = 3 - Len(Text33.Value)
For iCnt = 1 To 2
.Cells(58, 49 + iCnt * 3).Value = ""
Next iCnt
For iCnt = LCnt To 2
.Cells(58, 49 + iCnt * 3).Value = Mid(Format(Text33.Value, "00"), iCnt, 1)
Next iCnt
LCnt = 8 - Len(Text34.Value)
For iCnt = 1 To 7
.Cells(58, 60 + iCnt * 3).Value = ""
Next iCnt
For iCnt = LCnt To 7
.Cells(58, 60 + iCnt * 3).Value = Mid(Format(Text34.Value, "0000000"), iCnt, 1)
Next iCnt
'支給単位2
For iCnt = 1 To 6
.Cells(66, 8 + iCnt * 3).Value = Mid(Format(TextBox15.Value, "000000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 4
.Cells(66, 29 + iCnt * 3).Value = Mid(Format(TextBox16.Value, "0000"), iCnt, 1)
Next iCnt
LCnt = 3 - Len(TextBox17.Value)
For iCnt = 1 To 2
.Cells(66, 49 + iCnt * 3).Value = ""
Next iCnt
For iCnt = LCnt To 2
.Cells(66, 49 + iCnt * 3).Value = Mid(Format(TextBox17.Value, "00"), iCnt, 1)
Next iCnt
LCnt = 8 - Len(TextBox14.Value)
For iCnt = 1 To 7
.Cells(66, 60 + iCnt * 3).Value = ""
Next iCnt
For iCnt = LCnt To 7
.Cells(66, 60 + iCnt * 3).Value = Mid(Format(TextBox14.Value, "0000000"), iCnt, 1)
Next iCnt
'職場復帰年月日
For iCnt = 1 To 6
.Cells(74, 8 + iCnt * 3).Value = Mid(Format(Text41.Value, "000000"), iCnt, 1)
Next iCnt
'支給対象となる期間の延長事由
.Cells(74, 32).Value = Text43.Value
For iCnt = 1 To 6
.Cells(74, 35 + iCnt * 3).Value = Mid(Format(Text44.Value, "000000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 4
.Cells(74, 56 + iCnt * 3).Value = Mid(Format(Text45.Value, "0000"), iCnt, 1)
Next iCnt
'証明年月日
.Cells(125, 9).Value = Text47.Value
.Cells(125, 17).Value = Text17.Value
.Cells(125, 25).Value = Text28.Value
'申請年月日
.Cells(136, 9).Value = Text20.Value
.Cells(136, 17).Value = Text21.Value
.Cells(136, 25).Value = Text22.Value
'事業所所在地
' .Cells(121, 58).Value = Text29.Value
' .Cells(123, 58).Value = Text18.Value
' .Cells(125, 47).Value = Text19.Value
' .Cells(127, 47).Value = Text55.Value
'申請者フリガナ漢字
.Cells(133, 62).Value = Text23.Value
.Cells(135, 62).Value = Text24.Value
'20110818 kon
'職安
.Cells(137, 37).Value = Text55.Value
'配偶者の被保険者番号
.Cells(82, 8).Value = Text48.Value
For iCnt = 1 To 4
.Cells(82, 14 + iCnt * 3).Value = Mid(Format(Text49.Value, "0000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 6
.Cells(82, 29 + iCnt * 3).Value = Mid(Format(Text50.Value, "000000"), iCnt, 1)
Next iCnt
.Cells(82, 53).Value = Text51.Value
'賃金締切日
.Cells(169, 17).Value = Text9.Value
'通勤手当
Select Case cmb1.Value
Case "有"
.Cells(169, 38).Value = "○"
.Cells(171, 38).Value = ""
Case "無"
.Cells(171, 38).Value = "○"
.Cells(169, 38).Value = ""
Case Else
.Cells(171, 38).Value = ""
.Cells(169, 38).Value = ""
End Select
Select Case cmb2.Value
Case "毎月"
.Cells(169, 40).Value = "○"
.Cells(169, 43).Value = ""
.Cells(169, 46).Value = ""
.Cells(169, 49).Value = ""
Case "３か月"
.Cells(169, 43).Value = "○"
.Cells(169, 40).Value = ""
.Cells(169, 46).Value = ""
.Cells(169, 49).Value = ""
Case "６か月"
.Cells(169, 46).Value = "○"
.Cells(169, 40).Value = ""
.Cells(169, 43).Value = ""
.Cells(169, 49).Value = ""
Case Else
.Cells(169, 46).Value = ""
.Cells(169, 40).Value = ""
.Cells(169, 43).Value = ""
.Cells(169, 49).Value = cmb2.Value
End Select
.Cells(171, 40).Value = Text53.Value
'賃金支払日
Select Case cmb3.Value
Case "当月"
.Cells(171, 17).Value = "○"
.Cells(171, 21).Value = ""
Case "翌月"
.Cells(171, 17).Value = ""
.Cells(171, 21).Value = "○"
Case Else
.Cells(171, 17).Value = ""
.Cells(171, 21).Value = ""
End Select
.Cells(171, 26).Value = Text52.Value
'備考
.Cells(173, 9).Value = Text54.Value
'20101111 kon
.Cells(34, 2).Value = Text30.Value
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub 登録1340()
Dim iCnt As Integer
Dim LCnt As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim fName As String
fName = ActiveSheet.Name
With ThisWorkbook.Worksheets(fName)
' With ThisWorkbook.Worksheets("1340確認票")
'被保険者番号
For iCnt = 1 To 4
.Cells(10, 22 + iCnt * 3).Value = Mid(Format(Text1.Value, "0000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 6
.Cells(10, 37 + iCnt * 3).Value = Mid(Format(Text2.Value, "000000"), iCnt, 1)
Next iCnt
.Cells(10, 61).Value = Text3.Value
'資格取得年月日
.Cells(10, 69).Value = Text42.Value
For iCnt = 1 To 6
.Cells(10, 72 + iCnt * 3).Value = Mid(Format(Text4.Value, "000000"), iCnt, 1)
Next iCnt
'事業所番号
For iCnt = 1 To 4
.Cells(17, 5 + iCnt * 3).Value = Mid(Format(Text5.Value, "0000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 6
.Cells(17, 20 + iCnt * 3).Value = Mid(Format(Text6.Value, "000000"), iCnt, 1)
Next iCnt
.Cells(17, 44).Value = Text7.Value
'育児休業開始年月日
For iCnt = 1 To 6
.Cells(25, 8 + iCnt * 3).Value = Mid(Format(Text8.Value, "000000"), iCnt, 1)
Next iCnt
'出産年月日
For iCnt = 1 To 6
.Cells(25, 38 + iCnt * 3).Value = Mid(Format(Text10.Value, "000000"), iCnt, 1)
Next iCnt
'被保険者の郵便番号
.Cells(25, 63).Value = Mid(Format(Text46.Value, "000"), 1, 1)
.Cells(25, 66).Value = Mid(Format(Text46.Value, "000"), 2, 1)
.Cells(25, 69).Value = Mid(Format(Text46.Value, "000"), 3, 1)
.Cells(25, 75).Value = Mid(Format(Text11.Value, "0000"), 1, 1)
.Cells(25, 78).Value = Mid(Format(Text11.Value, "0000"), 2, 1)
.Cells(25, 81).Value = Mid(Format(Text11.Value, "0000"), 3, 1)
.Cells(25, 84).Value = Mid(Format(Text11.Value, "0000"), 4, 1)
'被保険者の住所
For iCnt = 1 To 20
.Cells(33, 5 + iCnt * 3).Value = Mid(Text12.Value, iCnt, 1)
Next iCnt
For iCnt = 1 To 20
.Cells(41, 5 + iCnt * 3).Value = Mid(Text13.Value, iCnt, 1)
Next iCnt
For iCnt = 1 To 20
.Cells(49, 5 + iCnt * 3).Value = Mid(TextBox13.Value, iCnt, 1)
Next iCnt
Cells(200, 1).Value = Text12.Value & Text13.Value & TextBox13.Value '月額証明書用の住所
'電話番号
For iCnt = 1 To 5
.Cells(56, 5 + iCnt * 3).Value = Mid(Text14.Value, iCnt, 1)
Next iCnt
For iCnt = 1 To 5
.Cells(56, 23 + iCnt * 3).Value = Mid(Text15.Value, iCnt, 1)
Next iCnt
For iCnt = 1 To 5
.Cells(56, 41 + iCnt * 3).Value = Mid(Text16.Value, iCnt, 1)
Next iCnt
'支給単位1
For iCnt = 1 To 6
.Cells(65, 8 + iCnt * 3).Value = Mid(Format(Text31.Value, "000000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 4
.Cells(65, 29 + iCnt * 3).Value = Mid(Format(Text32.Value, "0000"), iCnt, 1)
Next iCnt
LCnt = 3 - Len(Text33.Value)
For iCnt = 1 To 2
.Cells(65, 49 + iCnt * 3).Value = ""
Next iCnt
'20140926 kon 就業時間追加
'YBNO 29511 ito 20151214 201601新様式対応
'If fName = "1040確認票" Then
If fName = "1040確認票" Or fName = "確認票201601" Then
For iCnt = 1 To 2
.Cells(65, 42 + iCnt * 3).Value = Mid(Format(Text33.Value, "00"), iCnt, 1)
Next iCnt
Else
For iCnt = 1 To 2
.Cells(65, 49 + iCnt * 3).Value = Mid(Format(Text33.Value, "00"), iCnt, 1)
Next iCnt
End If
LCnt = 8 - Len(Text34.Value)
For iCnt = 1 To 7
.Cells(65, 60 + iCnt * 3).Value = ""
Next iCnt
For iCnt = LCnt To 7
.Cells(65, 60 + iCnt * 3).Value = Mid(Format(Text34.Value, "0000000"), iCnt, 1)
Next iCnt
'支給単位2
For iCnt = 1 To 6
.Cells(73, 8 + iCnt * 3).Value = Mid(Format(TextBox15.Value, "000000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 4
.Cells(73, 29 + iCnt * 3).Value = Mid(Format(TextBox16.Value, "0000"), iCnt, 1)
Next iCnt
LCnt = 3 - Len(TextBox17.Value)
For iCnt = 1 To 2
.Cells(73, 49 + iCnt * 3).Value = ""
Next iCnt
'20140926 kon 就業時間追加
'YBNO 29511 ito 20151214 201601新様式対応
'If fName = "1040確認票" Then
If fName = "1040確認票" Or fName = "確認票201601" Then
For iCnt = 1 To 2
.Cells(73, 42 + iCnt * 3).Value = Mid(Format(TextBox17.Value, "00"), iCnt, 1)
Next iCnt
Else
For iCnt = 1 To 2
.Cells(73, 49 + iCnt * 3).Value = Mid(Format(TextBox17.Value, "00"), iCnt, 1)
Next iCnt
End If
LCnt = 8 - Len(TextBox14.Value)
For iCnt = 1 To 7
.Cells(73, 60 + iCnt * 3).Value = ""
Next iCnt
For iCnt = LCnt To 7
.Cells(73, 60 + iCnt * 3).Value = Mid(Format(TextBox14.Value, "0000000"), iCnt, 1)
Next iCnt
'支給単位3
For iCnt = 1 To 6
.Cells(80, 8 + iCnt * 3).Value = Mid(Format(TextBox23.Value, "000000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 4
.Cells(80, 29 + iCnt * 3).Value = Mid(Format(TextBox24.Value, "0000"), iCnt, 1)
Next iCnt
LCnt = 3 - Len(TextBox25.Value)
For iCnt = 1 To 2
.Cells(80, 49 + iCnt * 3).Value = ""
Next iCnt
'20140926 kon 就業時間追加
'YBNO 29511 ito 20151214 201601新様式対応
'If fName = "1040確認票" Then
If fName = "1040確認票" Or fName = "確認票201601" Then
For iCnt = 1 To 2
.Cells(80, 42 + iCnt * 3).Value = Mid(Format(TextBox25.Value, "00"), iCnt, 1)
Next iCnt
Else
For iCnt = 1 To 2
.Cells(80, 49 + iCnt * 3).Value = Mid(Format(TextBox25.Value, "00"), iCnt, 1)
Next iCnt
End If
LCnt = 8 - Len(TextBox22.Value)
For iCnt = 1 To 7
.Cells(80, 60 + iCnt * 3).Value = ""
Next iCnt
For iCnt = LCnt To 7
.Cells(80, 60 + iCnt * 3).Value = Mid(Format(TextBox22.Value, "0000000"), iCnt, 1)
Next iCnt
'職場復帰年月日
For iCnt = 1 To 6
.Cells(88, 8 + iCnt * 3).Value = Mid(Format(Text41.Value, "000000"), iCnt, 1)
Next iCnt
'支給対象となる期間の延長事由
.Cells(88, 32).Value = Text43.Value
For iCnt = 1 To 6
.Cells(88, 35 + iCnt * 3).Value = Mid(Format(Text44.Value, "000000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 4
.Cells(88, 56 + iCnt * 3).Value = Mid(Format(Text45.Value, "0000"), iCnt, 1)
Next iCnt
'証明年月日
.Cells(139, 9).Value = Text47.Value
.Cells(139, 17).Value = Text17.Value
.Cells(139, 25).Value = Text28.Value
'申請年月日
.Cells(150, 9).Value = Text20.Value
.Cells(150, 17).Value = Text21.Value
.Cells(150, 25).Value = Text22.Value
'20110818 kon
'職安
.Cells(151, 37).Value = Text55.Value
'申請者フリガナ
.Cells(147, 62).Value = Text23.Value
'申請者漢字
.Cells(149, 62).Value = Text24.Value
'配偶者の被保険者番号
.Cells(96, 8).Value = Text48.Value
For iCnt = 1 To 4
.Cells(96, 14 + iCnt * 3).Value = Mid(Format(Text49.Value, "0000"), iCnt, 1)
Next iCnt
For iCnt = 1 To 6
.Cells(96, 29 + iCnt * 3).Value = Mid(Format(Text50.Value, "000000"), iCnt, 1)
Next iCnt
.Cells(96, 53).Value = Text51.Value
'賃金締切日
.Cells(183, 17).Value = Text9.Value
'通勤手当
Select Case cmb1.Value
Case "有"
.Cells(183, 38).Value = "○"
.Cells(185, 38).Value = ""
Case "無"
.Cells(185, 38).Value = "○"
…
|
|||
Open this report in the interactive analyzer, or submit your own file for analysis.