MALICIOUS
102
Risk Score
Malware Insights
MITRE ATT&CK
T1059.005 Visual Basic
T1566.001 Spearphishing Attachment
T1059 Command and Scripting Interpreter
The sample is an Excel file containing VBA macros, identified by the 'OLE_VBA_MACROS' heuristic. The presence of 'CreateProcess' and 'ShellExecute' API references suggests that the macros are designed to execute external processes or commands. The document body contains Japanese text related to childcare and parental leave applications, likely serving as a lure to trick users into opening the malicious file. The benign URL is likely a decoy.
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) | 390190 bytes |
SHA-256: 22d35da4ad0118efdf9172d57230311f748bb620582d33b4212ceb9a5877ca38 |
|||
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{29AEC860-A66B-48D2-9158-B9C8836B1A35}{863FC475-F70A-4CCE-A8D5-AB9049FFE284}"
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
' 登録
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 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"
ElseIf ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 3 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
param = 1
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 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
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
Case "1340確認票"
'金融機関
'フリガナ
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 = "新育児休業給付受給資格確認票の保存"
Else
登録1340
'20110818 KON
保存F.Caption = "2011育児休業給付受給資格確認票の保存"
End If
保存F.TextBox1.Value = Text24.Value
'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 = "新育児休業給付受給資格確認票の読込"
Else
フォーム読込.Caption = "2011育児休業給付受給資格確認票の読込"
End If
' フォーム読込.Caption = "新育児休業給付受給資格確認票の読込"
フォーム読込.Show
Unload Me
End Sub
Private Sub CommandButton7_Click()
フォーム払渡銀行.Show
End Sub
Private Sub CommandButton8_Click()
フォーム事業主.Show
End Sub
Private Sub ListBox1_Click()
Dim iCnt(2) As Integer
If ListBox1.ListIndex = -1 Then Exit Sub
For i = 1 To 45
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
Controls("Text" & 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
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()
If ThisWorkbook.Sheets("MENU").Cells(5, 4).Value = 1 Then '201101様式だったら
登録
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
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
For iCnt = LCnt To 2
.Cells(65, 49 + iCnt * 3).Value = Mid(Format(Text33.Value, "00"), iCnt, 1)
Next iCnt
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
For iCnt = LCnt To 2
.Cells(73, 49 + iCnt * 3).Value = Mid(Format(TextBox17.Value, "00"), iCnt, 1)
Next iCnt
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
For iCnt = LCnt To 2
.Cells(80, 49 + iCnt * 3).Value = Mid(Format(TextBox25.Value, "00"), iCnt, 1)
Next iCnt
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 = "○"
.Cells(183, 38).Value = ""
Case Else
.Cells(185, 38).Value = ""
.Cells(183, 38).Value = ""
End Select
Select Case cmb2.Value
Case "毎月"
.Cells(183, 40).Value = "○"
.Cells(183, 43).Value = ""
.Cells(183, 46).Value = ""
.Cells(183, 49).Value = ""
Case "３か月"
.Cells(183, 43).Value = "○"
.Cells(183, 40).Value = ""
.Cells(183, 46).Value = ""
.Cells(183, 49).Value = ""
Case "６か月"
.Cells(183, 46).Value = "○"
.Cells(183, 40).Value = ""
.Cells(183, 43).Value = ""
.Cells(183, 49).Value = ""
Case Else
.Cells(183, 46).Value = ""
.Cells(183, 40).Value = ""
.Cells(183, 43).Value = ""
.Cells(183, 49).Value = cmb2.Value
End Select
.Cells(185, 40).Value = Text53.Value
'賃金支払日
Select Case cmb3.Value
Case "当月"
.Cells(185, 17).Value = "○"
.Cells(185, 21).Value = ""
Case "翌月"
.Cells(185, 17).Value = ""
.Cells(185, 21).Value = "○"
Case Else
.Cells(185, 17).Value = ""
.Cells(185, 21).Value = ""
End Select
.Cells(185, 26).Value = Text52.Value
'備考
.Cells(187, 9).Value = Text54.Value
'' .Cells(34, 2).Value = Text30.Value
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub 表示()
Dim iCnt As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ThisWorkbook.Worksheets("新確認票初回")
'被保険者番号
For iCnt = 1 To 4
Text1.Value = Text1.Value & .Cells(10, 22 + iCnt * 3).Value
Next iCnt
For iCnt = 1 To 6
Text2.Value = Text2.Value & .Cells(10, 37 + iCnt * 3).Value
Next iCnt
Text3.Value = .Cells(10, 61).Value
'資格取得年月日
Text42.Value = .Cells(10, 69).Value
For iCnt = 1 To 6
Text4.Value = Text4.Value & .Cells(10, 72 + iCnt * 3).Value
Next iCnt
'事業所番号
For iCnt = 1 To 4
Text5.Value = Text5.Value & .Cells(17, 5 + iCnt * 3).Value
Next iCnt
For iCnt = 1 To 6
Text6.Value = Text6.Value & .Cells(17, 20 + iCnt * 3).Value
Next iCnt
Text7.Value = .Cells(17, 44).Value
'育児休業開始年月日
For iCnt = 1 To 6
Text8.Value = Text8.Value & .Cells(25, 8 + iCnt * 3).Value
Next iCnt
'出産年月日
For iCnt = 1 To 6
Text10.Value = Text10.Value & .Cells(25, 38 + iCnt * 3).Value
Next iCnt
'被保険者の郵便番号
Text46.Value = .Cells(25, 63).Value & .Cells(25, 66).Value & .Cells(25, 69).Value
Text11.Value = .Cells(25, 75).Value & .Cells(25, 78).Value & .Cells(25, 81).Value & .Cells(25, 84).Value
'被保険者の住所
For iCnt = 1 To 27
Text12.Value = Text12.Value & .Cells(33, 5 + iCnt * 3).Value
Next iCnt
For iCnt = 1 To 27
Text13.Value = Text13.Value & .Cells(41, 5 + iCnt * 3).Value
Next iCnt
'電話番号
For iCnt = 1 To 5
Text14.Value = Text14.Value & .Cells(49, 5 + iCnt * 3).Value
Next iCnt
For iCnt = 1 To 5
Text15.Value = Text15.Value & .Cells(49, 23 + iCnt * 3).Value
Next iCnt
For iCnt = 1 To 5
Text16.Value = Text16.Value & .Cells(49, 41 + iCnt * 3).Value
Next iCnt
'支給単位1
For iCnt = 1 To 6
Text31.Value = Text31.Value & .Cells(58, 8 + iCnt * 3).Value
Next iCnt
For iCnt = 1 To 4
Text32.Value = Text32.Value & .Cells(58, 29 + iCnt * 3).Value
Next iCnt
For iCnt = 1 To 2
Text33.Value = Text33.Value & .Cells(58, 49 + iCnt * 3).Value
Next iCnt
For iCnt = 1 To 7
Text34.Value = Text34.Value & .Cells(58, 60 + iCnt * 3).Value
Next iCnt
'支給単位2
For iCnt = 1 To 6
TextBox15.Value = TextBox15.Value & .Cells(66, 8 + iCnt * 3).Value
Next iCnt
For iCnt = 1 To 4
…
|
|||
Open this report in the interactive analyzer, or submit your own file for analysis.