MALICIOUS
162
Risk Score
Malware Insights
MITRE ATT&CK
T1059.005 Visual Basic
T1497.001 System Checks: System Service Discovery
The sample is an Excel file containing a large VBA macro, indicating malicious intent. The macro references CreateProcess and ShellExecute APIs, suggesting it's designed to execute external commands or launch other processes. The document body contains Japanese text related to social insurance and benefits, likely a lure to deceive the user into interacting with the malicious content. No specific malware family is identifiable from the provided evidence.
Heuristics 6
-
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 1 related finding OLE_VBA_MACROSDocument contains VBA macro code
-
CreateObject call high OLE_VBA_CREATEOBJCreateObject callMatched line in script
Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") Dim n As Long -
NOP-equivalent sled detected medium SC_NOP_EQUIV_SLEDLong run of 0x41 bytes
Disassembly
Attempted x86 opcode disassembly0016CC24 41 inc ecx 0016CC25 41 inc ecx 0016CC26 41 inc ecx 0016CC27 41 inc ecx 0016CC28 41 inc ecx 0016CC29 41 inc ecx 0016CC2A 41 inc ecx 0016CC2B 41 inc ecx 0016CC2C 41 inc ecx 0016CC2D 41 inc ecx 0016CC2E 41 inc ecx 0016CC2F 41 inc ecx 0016CC30 41 inc ecx 0016CC31 41 inc ecx 0016CC32 41 inc ecx 0016CC33 41 inc ecx 0016CC34 41 inc ecx 0016CC35 41 inc ecx 0016CC36 41 inc ecx 0016CC37 41 inc ecx 0016CC38 41 inc ecx 0016CC39 41 inc ecx 0016CC3A 41 inc ecx 0016CC3B 41 inc ecx 0016CC3C 41 inc ecx 0016CC3D 41 inc ecx 0016CC3E 41 inc ecx 0016CC3F 41 inc ecx 0016CC40 41 inc ecx 0016CC41 41 inc ecx 0016CC42 41 inc ecx 0016CC43 41 inc ecx 0016CC44 41 inc ecx 0016CC45 41 inc ecx 0016CC46 41 inc ecx 0016CC47 41 inc ecx 0016CC48 41 inc ecx 0016CC49 41 inc ecx 0016CC4A 41 inc ecx 0016CC4B 41 inc ecx 0016CC4C 41 inc ecx 0016CC4D 41 inc ecx 0016CC4E 41 inc ecx 0016CC4F 41 inc ecx 0016CC50 41 inc ecx 0016CC51 41 inc ecx 0016CC52 41 inc ecx 0016CC53 41 inc ecx 0016CC54 41 inc ecx 0016CC55 41 inc ecx 0016CC56 41 inc ecx 0016CC57 41 inc ecx 0016CC58 41 inc ecx 0016CC59 41 inc ecx 0016CC5A 41 inc ecx 0016CC5B 41 inc ecx 0016CC5C 41 inc ecx 0016CC5D 41 inc ecx 0016CC5E 41 inc ecx 0016CC5F 41 inc ecx 0016CC60 41 inc ecx 0016CC61 41 inc ecx 0016CC62 41 inc ecx 0016CC63 41 inc ecx 0016CC64 41 inc ecx 0016CC65 42 inc edx 0016CC66 1111 adc dword ptr [ecx], edx 0016CC68 1414 adc al, 0x14 0016CC6A 1414 adc al, 0x14 0016CC6C 1414 adc al, 0x14 0016CC6E 1414 adc al, 0x14 0016CC70 1414 adc al, 0x14 0016CC72 1414 adc al, 0x14 0016CC74 1414 adc al, 0x14 0016CC76 1414 adc al, 0x14 0016CC78 1414 adc al, 0x14 0016CC7A 1414 adc al, 0x14 0016CC7C 1414 adc al, 0x14 0016CC7E 1414 adc al, 0x14 0016CC80 1414 adc al, 0x14 0016CC82 1414 adc al, 0x14
-
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) | 670541 bytes |
SHA-256: 19a70813c05a5d61c7a11d48a44a6c103e2c1bbe3527c11bb9cc2ca7ce8c6306 |
|||
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 = "Sheet19"
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 = "印刷F"
Attribute VB_Base = "0{501589BE-A4A4-48ED-BA19-AFCD958C8B3C}{FE7BC327-6076-4952-9667-A9BCC5DD377D}"
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 f As Integer '#28140 20150716 ishikawa
Private Sub UserForm_Initialize()
'余白設定のファイル名
hName = ThisWorkbook.Path & "\pdf\健康保険\" & ActiveSheet.Name & "\print.txt"
Dim j As Integer
Dim intFF As Integer ' FreeFile値
Dim setString(2) As Double
Dim strREC As String ' 読み込んだレコード内容
For j = 0 To 9
TxtTop.AddItem j
TxtLeft.AddItem j
Next j
If Dir(hName, vbNormal) <> "" Then
j = 0
intFF = FreeFile
Open hName For Input As intFF
Do Until EOF(intFF)
Line Input #intFF, strREC
setString(j) = IIf(Trim(strREC) = "", 0, strREC)
j = j + 1
Loop
Close #1
TxtTop.Value = setString(0) * 10 '上余白
TxtLeft.Value = setString(1) * 10 '左余白
Else
TxtTop.Value = 0 '上余白
TxtLeft.Value = 0 '左余白
End If
End Sub
Private Sub CommandButton1_Click()
If TxtTop.Text < 0 Then
MsgBox "上余白は0から9までの数字で設定してください。"
Exit Sub
End If
If TxtLeft.Text < 0 Then
MsgBox "左余白は0から9までの数字で設定してください。"
Exit Sub
End If
If OptionButton1.Value = True Then
Call 現シート印刷
ElseIf OptionButton2.Value = True Then
Call 印刷へ(ActiveSheet.Name, False)
ElseIf OptionButton3.Value = True Then
Call 印刷へ(ActiveSheet.Name, True)
End If
Unload Me
End Sub
Private Sub 現シート印刷()
DoEvents
ActiveSheet.PrintOut
DoEvents
End Sub
Sub 印刷へ(kenko, PMode)
Dim Yousi As String
Dim Button As String
Dim wb As Object
Dim fnam As String
fnam = ThisWorkbook.Path & "\pdf\健康保険\" & kenko & "\" & 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
If Dir(ThisWorkbook.Path & "\pdf\健康保険\" & kenko & "\", vbDirectory) = "" Then
MkDir (ThisWorkbook.Path & "\pdf\健康保険\" & kenko & "\")
End If
Call 様式印刷(fnam, kenko)
Dim ShellString As String
Dim param As String
Select Case kenko
Case "出産手当金"
param = 1
Case "療養費装具"
param = 2
Case "療養費立替払"
param = 3
Case "再交付申請書"
param = 4
Case "高額療養費"
param = 5
Case "傷病手当金"
param = 6
Case "限度額適用認定"
param = 7
Case "標準負担額"
param = 8
Case "任意継続"
param = 9
Case "高齢受給者証"
param = 10
Case "負傷原因"
param = 11
'-------------------------------------20141106 様式追加 ishikawa
Case "出産育児一時金"
param = 12
Case "内払差額"
param = 13
Case "埋葬料"
param = 14
Case "特定疾病"
param = 15
'-------------------------------------ここまで
End Select
Tmargin = IIf(Trim(TxtTop.Value) = "", 0, TxtTop.Value / 10) '上余白
Lmargin = IIf(Trim(TxtLeft.Value) = "", 0, TxtLeft.Value / 10) '左余白
ShellString = """" & PathCombine(ThisWorkbook.Path, "健康保険.exe") & """ """ & PathCombine(GetProgramFolder, "健康保険") & "\" & kenko & """ """ & fnam & """ """ & param & """ """ & PMode & """ """ & Tmargin & """ """ & Lmargin & """"
ExecCmd ShellString
Application.ScreenUpdating = True
Exit Sub
End Sub
Private Sub 様式印刷(TextFilename, yousiki)
Dim i As Long
Dim jCounter As Long
Dim MyStr As String
Dim MyTab As String
Dim TxtYohaku As String
If MsgBox("印刷を開始します。", 4 + 32, "印刷") <> 6 Then Exit Sub
If ActiveSheet.Name = "出産手当金" Then
Call 出産手当金印刷(TextFilename)
End If
If ActiveSheet.Name = "療養費装具" Then
Call 療養費装具印刷(TextFilename)
End If
If ActiveSheet.Name = "療養費立替払" Then
Call 療養費立替払印刷(TextFilename)
End If
If ActiveSheet.Name = "再交付申請書" Then
Call 再交付申請書印刷(TextFilename)
End If
If ActiveSheet.Name = "高額療養費" Then
Call 高額療養費印刷(TextFilename)
End If
If ActiveSheet.Name = "傷病手当金" Then
Call 傷病手当金印刷(TextFilename)
End If
If ActiveSheet.Name = "限度額適用認定" Then
Call 限度額適用認定印刷(TextFilename)
End If
If ActiveSheet.Name = "標準負担額" Then
Call 標準負担額印刷(TextFilename)
End If
If ActiveSheet.Name = "任意継続" Then
Call 任意継続印刷(TextFilename)
End If
If ActiveSheet.Name = "高齢受給者証" Then
Call 高齢受給者証印刷(TextFilename)
End If
If ActiveSheet.Name = "負傷原因" Then
Call 負傷原因印刷(TextFilename)
End If
'-------------------------------------20141106 様式追加 ishikawa
If ActiveSheet.Name = "出産育児一時金" Then
Call 出産育児一時金印刷(TextFilename)
End If
If ActiveSheet.Name = "内払差額" Then
Call 内払差額印刷(TextFilename)
End If
If ActiveSheet.Name = "埋葬料" Then
Call 埋葬料印刷(TextFilename)
End If
If ActiveSheet.Name = "特定疾病" Then
Call 特定疾病印刷(TextFilename)
End If
'-------------------------------------ここまで
TxtYohaku = ThisWorkbook.Path & "\pdf\健康保険\" & yousiki
If Dir(TxtYohaku & "\print.txt") = "" Then
Open TxtYohaku & "\print.txt" For Append As #1
Print #1, IIf(TxtTop.Value = 0, 0, TxtTop.Value / 10) '上余白
Print #1, IIf(TxtLeft.Value = 0, 0, TxtLeft.Value / 10) '左余白
Close #1
Else
Open hName For Output As #1
Print #1, IIf(TxtTop.Value = 0, 0, TxtTop.Value / 10) '上余白
Print #1, IIf(TxtLeft.Value = 0, 0, TxtLeft.Value / 10) '左余白
Close #1
End If
End Sub
Function Tab区切(zi As String, su As Long, b As Boolean)
Dim jCounter As Long
Dim a As String
zi = Left(zi, su) '指定の数より多い文字数が入っている場合を想定
If b = False Then '右詰め
zi = Space(su - Len(Left(zi, su))) & zi 'スペースを設定してその数に合わせる
Else '左詰め
zi = zi & Space(su - Len(Left(zi, su)))
End If
For jCounter = 1 To Len(zi)
If jCounter = 1 Then
a = Mid(zi, jCounter, 1)
Else
a = a & vbTab & Mid(zi, jCounter, 1)
End If
Next
Tab区切 = a
End Function
Sub 電話(a As String) '#28140 20150716 ishikawa
If a Like "*-*-*" Then
Else
f = 1
End If
End Sub
Sub 郵便番号(a As String) '#28140 20150716 ishikawa
If a Like "*-*" Then
Else
f = 1
End If
End Sub
Sub 日付(a As String) '#28140 20150716 ishikawa
If a Like "*/*/*" Then
Else
f = 1
End If
End Sub
Sub 出産手当金印刷(TFname)
Dim i As Long
Dim n As Integer
Dim jCounter As Long
Dim MyStr As String
Dim MyTab As String
Dim TxtYohaku As String
With Worksheets("DATA")
If ActiveSheet.Name = "出産手当金" Then
Dim MyD5(1 To 261, 1 To 3)
TxtYohaku = ThisWorkbook.Path & "\pdf\健康保険\出産手当金\"
TFname = ThisWorkbook.Path & "\pdf\健康保険\出産手当金\" & Trim(Cells(27, 16).Value) & Format(Now(), "YYYYMMDDHHSS") & ".TDF"
Open TFname For Output As #1
Print #1, ""
For i = 4 To 264
MyStr = Cells(.Cells(i, 12), .Cells(i, 13)).Value
MyD5(i - 3, 1) = .Cells(i, 11).Value '項目名
MyD5(i - 3, 2) = MyStr 'データ
MyD5(i - 3, 3) = MyStr '3列目は印刷用データ
' If InStr(MyD5(i - 3, 3), vbCrLf) > 0 Then 'テキストボックスで改行(コードを@に変換)
' MyD5(i - 3, 3) = Replace(MyD5(i - 3, 3), vbCrLf, "@")
' ElseIf InStr(MyD5(i - 3, 3), vbLf) > 0 Then 'セルで改行
' MyD5(i - 3, 3) = Replace(MyD5(i - 3, 3), vbLf, "@")
' End If
If i = 4 Then '記号
MyD5(i - 3, 3) = Tab区切(MyStr, 8, True)
ElseIf i = 5 Then '番号
MyD5(i - 3, 3) = Tab区切(MyStr, 7, True)
ElseIf i = 6 Then '生年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 10 Then '郵便番号 #28140 20150716 ishikawa
If MyStr <> "" Then
郵便番号 (MyStr)
End If
If f = 1 Then
MsgBox "郵便番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 14 Then '電話 #28140 20150716 ishikawa
If MyStr <> "" Then
電話 (MyStr)
End If
If f = 1 Then
MsgBox "電話番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 20 Then '口座番号
MyD5(i - 3, 3) = Tab区切(MyStr, 7, True)
ElseIf i = 21 Then '口座名義
MyD5(i - 3, 3) = Tab区切(MyStr, 30, True)
ElseIf i = 24 Then '年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 25 Then '郵便番号 #28140 20150716 ishikawa
If MyStr <> "" Then
郵便番号 (MyStr)
End If
If f = 1 Then
MsgBox "郵便番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 26 Then '電話 #28140 20150716 ishikawa
If MyStr <> "" Then
電話 (MyStr)
End If
If f = 1 Then
MsgBox "電話番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 33 Then '出産予定日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 34 Then '出産日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 35 Then '申請期間自
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 36 Then '申請期間至
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 37 Then '申請期間
If MyStr = "" Or MyStr = "0" Then
MyD5(i - 3, 3) = ""
Else
MyD5(i - 3, 3) = MyStr
End If
ElseIf i = 39 Then '期間自
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 40 Then '期間至
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 41 Then '報酬の額
If MyStr = "" Or MyStr = "0" Then
MyD5(i - 3, 3) = ""
Else
MyD5(i - 3, 3) = Format(MyStr, "#,###")
End If
ElseIf i = 43 Then '年月日1
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 77 Then '年月日2
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 111 Then '年月日3
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 145 Then '年月日4
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 179 Then '年月日5
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 218 Then '期間自1
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 219 Then '期間至1
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 220 Then '期間自2
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 221 Then '期間至2
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 222 Then '期間自3
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 223 Then '期間至3
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 259 Then '年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 264 Then '電話 #28140 20150716 ishikawa
If MyStr <> "" Then
電話 (MyStr)
End If
If f = 1 Then
MsgBox "電話番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
End If
For n = 226 To 257
' MyD5(n - 3, 3) = Format(MyStr, "#,###")
MyD5(n - 3, 3) = Format(MyStr, "#,##0") '#26749 20150107 ishikawa
Next
Print #1, MyD5(i - 3, 3)
Next
Close #1
End If
End With
End Sub
Sub 療養費装具印刷(TFname)
Dim i As Long
Dim jCounter As Long
Dim MyStr As String
Dim MyTab As String
Dim TxtYohaku As String
With Worksheets("DATA")
If ActiveSheet.Name = "療養費装具" Then
Dim MyD5(1 To 52, 1 To 3)
TxtYohaku = ThisWorkbook.Path & "\pdf\健康保険\療養費装具\"
TFname = ThisWorkbook.Path & "\pdf\健康保険\療養費装具\" & Trim(Cells(27, 16).Value) & Format(Now(), "YYYYMMDDHHSS") & ".TDF"
Open TFname For Output As #1
Print #1, ""
For i = 4 To 55
MyStr = Cells(.Cells(i, 16), .Cells(i, 17)).Value
MyD5(i - 3, 1) = .Cells(i, 15).Value '項目名
MyD5(i - 3, 2) = MyStr 'データ
MyD5(i - 3, 3) = MyStr '3列目は印刷用データ
' If InStr(MyD5(i - 3, 3), vbCrLf) > 0 Then 'テキストボックスで改行(コードを@に変換)
' MyD5(i - 3, 3) = Replace(MyD5(i - 3, 3), vbCrLf, "@")
' ElseIf InStr(MyD5(i - 3, 3), vbLf) > 0 Then 'セルで改行
' MyD5(i - 3, 3) = Replace(MyD5(i - 3, 3), vbLf, "@")
' End If
If i = 4 Then '記号
MyD5(i - 3, 3) = Tab区切(MyStr, 8, True)
ElseIf i = 5 Then '番号
MyD5(i - 3, 3) = Tab区切(MyStr, 7, True)
ElseIf i = 6 Then '生年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 10 Then '郵便番号 #28140 20150716 ishikawa
If MyStr <> "" Then
郵便番号 (MyStr)
End If
If f = 1 Then
MsgBox "郵便番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 14 Then '電話 #28140 20150716 ishikawa
If MyStr <> "" Then
電話 (MyStr)
End If
If f = 1 Then
MsgBox "電話番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 20 Then '口座番号
MyD5(i - 3, 3) = Tab区切(MyStr, 7, True)
ElseIf i = 21 Then '口座名義
MyD5(i - 3, 3) = Tab区切(MyStr, 30, True)
ElseIf i = 24 Then '年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 25 Then '郵便番号 #28140 20150716 ishikawa
If MyStr <> "" Then
郵便番号 (MyStr)
End If
If f = 1 Then
MsgBox "郵便番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 26 Then '電話 #28140 20150716 ishikawa
If MyStr <> "" Then
電話 (MyStr)
End If
If f = 1 Then
MsgBox "電話番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 35 Then '家族の場合生年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 37 Then '発病年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 46 Then '診療期間自
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 47 Then '診療期間至
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 48 Then '診療日数
If MyStr = "" Or MyStr = "0" Then
MyD5(i - 3, 3) = ""
Else
MyD5(i - 3, 3) = MyStr
End If
ElseIf i = 49 Then '入院期間自
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 50 Then '入院期間至
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 51 Then '入院日数
If MyStr = "" Or MyStr = "0" Then
MyD5(i - 3, 3) = ""
Else
MyD5(i - 3, 3) = MyStr
End If
ElseIf i = 52 Then '指示を受けた日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 53 Then '療養の費用
If MyStr = "" Or MyStr = "0" Then
MyD5(i - 3, 3) = ""
Else
MyD5(i - 3, 3) = Format(MyStr, "#,###")
End If
End If
Print #1, MyD5(i - 3, 3)
Next
Close #1
End If
End With
End Sub
Sub 療養費立替払印刷(TFname)
Dim i As Long
Dim jCounter As Long
Dim MyStr As String
Dim MyTab As String
Dim TxtYohaku As String
With Worksheets("DATA")
If ActiveSheet.Name = "療養費立替払" Then
Dim MyD5(1 To 56, 1 To 3)
TxtYohaku = ThisWorkbook.Path & "\pdf\健康保険\療養費立替払\"
TFname = ThisWorkbook.Path & "\pdf\健康保険\療養費立替払\" & Trim(Cells(27, 16).Value) & Format(Now(), "YYYYMMDDHHSS") & ".TDF"
Open TFname For Output As #1
Print #1, ""
For i = 4 To 59
MyStr = Cells(.Cells(i, 20), .Cells(i, 21)).Value
MyD5(i - 3, 1) = .Cells(i, 19).Value '項目名
MyD5(i - 3, 2) = MyStr 'データ
MyD5(i - 3, 3) = MyStr '3列目は印刷用データ
' If InStr(MyD5(i - 3, 3), vbCrLf) > 0 Then 'テキストボックスで改行(コードを@に変換)
' MyD5(i - 3, 3) = Replace(MyD5(i - 3, 3), vbCrLf, "@")
' ElseIf InStr(MyD5(i - 3, 3), vbLf) > 0 Then 'セルで改行
' MyD5(i - 3, 3) = Replace(MyD5(i - 3, 3), vbLf, "@")
' End If
If i = 4 Then '記号
MyD5(i - 3, 3) = Tab区切(MyStr, 8, True)
ElseIf i = 5 Then '番号
MyD5(i - 3, 3) = Tab区切(MyStr, 7, True)
ElseIf i = 6 Then '生年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 10 Then '郵便番号 #28140 20150716 ishikawa
If MyStr <> "" Then
郵便番号 (MyStr)
End If
If f = 1 Then
MsgBox "郵便番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 14 Then '電話 #28140 20150716 ishikawa
If MyStr <> "" Then
電話 (MyStr)
End If
If f = 1 Then
MsgBox "電話番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 20 Then '口座番号
MyD5(i - 3, 3) = Tab区切(MyStr, 7, True)
ElseIf i = 21 Then '口座名義
MyD5(i - 3, 3) = Tab区切(MyStr, 30, True)
ElseIf i = 24 Then '年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 25 Then '郵便番号 #28140 20150716 ishikawa
If MyStr <> "" Then
郵便番号 (MyStr)
End If
If f = 1 Then
MsgBox "郵便番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 26 Then '電話 #28140 20150716 ishikawa
If MyStr <> "" Then
電話 (MyStr)
End If
If f = 1 Then
MsgBox "電話番号の入力形式が不正です。ハイフンが含まれているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
ElseIf i = 35 Then '家族の場合生年月日
If MyStr = "" Or MyStr = "0:00:00" Then
MyD5(i - 3, 3) = ""
Else
日付 (MyStr) '#28140 20150716 ishikawa
If f = 1 Then
MsgBox "日付の形式が不正です。正しく入力されているか確認してください。", vbOKOnly + vbExclamation, "印刷"
Close #1
Kill TFname
End
End If
MyD5(i - 3, 3) = Format(MyStr, "yyyy/mm/dd")
End If
ElseIf i = 37 Then '発病年月日
…
|
|||
Open this report in the interactive analyzer, or submit your own file for analysis.