Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    ThisWorkbook.Saved = True
        
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
    MsgBox "このファイルは保存できません。", 16, "保存不可"
    Cancel = True
    
End Sub

Attribute VB_Name = "Sheet9"
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 = "Sheet5"
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 = "Sheet7"
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 = "Sheet18"
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 = "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

Attribute VB_Name = "Sheet6"
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

Attribute VB_Name = "Sheet8"
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 = "社取得"
Attribute VB_Base = "0{7D86AE05-5D6F-4446-BC1E-16832CC4BB51}{54CFC00A-81E9-4076-944B-B283DA81A183}"
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 nn      As Integer
Private Sub UserForm_Initialize()

    Dim 都市区符号   As String
    Dim 事業所記号   As String
    Dim 告知番号     As String
    Dim TextFilename As String
    Dim MyStr        As String
    Dim i As Long
       
'   リストボックスにデータ表示
    With Workbooks(Worksheets("DATA").Cells(1, 1).Value).Worksheets("個人情報")
         For i = 6 To .Cells(10000, 2).End(xlUp).Row
            Me.ListBox1.AddItem .Cells(i, 5).Value & " " & .Cells(i, 6).Value
            If .Cells(i, 28).Value <> "" Then '喪失日にデータがあったら
                Me.ListBox1.List(i - 6, 1) = "×"
            End If
            If .Cells(i, 27).Value > (Date - 60) And Trim(.Cells(i, 28).Value) = "" Then  '取得日が60日前までで喪失していないデータだったら
                Me.ListBox3.AddItem .Cells(i, 5).Value & " " & .Cells(i, 6).Value
                Me.ListBox3.List(Me.ListBox3.ListCount - 1, 1) = .Cells(i, 2).Value
            End If
            Me.ListBox1.List(i - 6, 2) = .Cells(i, 2).Value
        Next
    End With
    
    CommandButton9.caption = "登録"
    CommandButton9.BackColor = &HFFFF80
    CommandButton2.Enabled = False
    
    'Application.ScreenUpdating = True

    ComboBox1.AddItem "0"
    ComboBox1.AddItem "1"
    ComboBox1.AddItem "2"
    ComboBox1.AddItem "3"
    ComboBox1.AddItem "4"
    ComboBox2.AddItem "1"
    ComboBox2.AddItem "2"
    ComboBox2.AddItem "3"
    ComboBox2.AddItem "5"
    ComboBox2.AddItem "6"
    ComboBox2.AddItem "7"
    ComboBox3.AddItem "0"
    ComboBox3.AddItem "1"
    
'    リストボックス2は変更用
    ListBox2.Visible = False
    ListBox1.Visible = True
    
    ListBox1.ColumnWidths = "80;15;0"
    ListBox3.ColumnWidths = "90;0"
    
    CommandButton9.caption = "登録"
    CommandButton9.BackColor = &HFFFF80
    CommandButton2.Enabled = False
                
                
    With ThisWorkbook.Worksheets("SHFD0006")
        都市区符号 = .Cells(4, 1).Value
        事業所記号 = .Cells(4, 2).Value
        告知番号 = .Cells(4, 3).Value
    End With
    TextBox3.Value = 都市区符号
    TextBox4.Value = 事業所記号
    TextBox5.Value = 告知番号
        
    If InStr(Application.Run("DaAddin.xla!OSInfoString"), "Windows 8") > 0 Then
        Me.CheckBox2.Value = True
        Me.CheckBox2.Enabled = False
    End If
    
    ''' YBNO 22141
    Application.Run "EAppCom.xla!DeleteCSVFile", ThisWorkbook

' '前回のCSVがあったら消す
'    Dim NewFn As String
'
'    NewFn = ThisWorkbook.path & "\SHFD0006\" & Worksheets("DATA").Cells(26, 2).Value & "\SHFD0006.csv"
'
'    If Dir(NewFn) <> vbNullString Then
'        Kill NewFn
'    End If

End Sub
Private Sub ListBox3_Click()

'   20091017masaya 最近入社した人はリストボックス１を下から検索する（個人情報に２つﾃﾞｰﾀがあるかもしれないから）
    Dim n As Integer
    Dim i As Long
    
    For i = 0 To ListBox1.ListCount - 1
       n = ListBox1.ListCount - 1 - i
    
       If ListBox1.List(n, 2) = ListBox3.List(ListBox3.ListIndex, 1) Then
           ListBox1.ListIndex = n
           Exit For
       End If
    Next
End Sub
Private Sub ListBox1_Click()

'    データを表示
    If ListBox1.ListIndex = -1 Then
    Exit Sub
    End If
    ToTextBox (ListBox1.ListIndex + 6)

End Sub

Sub ToTextBox(行位置 As Integer)
    With Workbooks(Worksheets("DATA").Cells(1, 1).Value).Worksheets("個人情報")
        TextBox6.Value = .Cells(行位置, 4).Value '被保険者番号
        TextBox7.Value = .Cells(行位置, 7).Value & " " & .Cells(行位置, 8).Value 'ｼﾒｲ
        TextBox8.Value = .Cells(行位置, 5).Value & "　" & .Cells(行位置, 6).Value '氏名
        TextBox9.Value = Left(Mydate(.Cells(行位置, 13).Value), 1) '生年月日
        TextBox10.Value = Right(Mydate(.Cells(行位置, 13).Value), 6)
        ComboBox2.Value = .Cells(行位置, 10).Value '種別
        If .Cells(行位置, 23).Value = "" Then '年金がなかったら
            ComboBox1.Value = "1"
            Else
            ComboBox1.Value = "2"
        End If
        TextBox13.Value = Left(.Cells(行位置, 23).Value, 4)  '基礎年金番号
        TextBox14.Value = Right(.Cells(行位置, 23).Value, 6)
        TextBox16.Value = Left(.Cells(行位置, 34).Value, 3)  '〒番号
        TextBox17.Value = Right(.Cells(行位置, 34).Value, 4)
        TextBox18.Value = .Cells(行位置, 36).Value '住所
        TextBox19.Value = .Cells(行位置, 35).Value
        TextBox26.Value = Left(Mydate(.Cells(行位置, 27).Value), 1)    '資格取得年月日
        TextBox27.Value = Right(Mydate(.Cells(行位置, 27).Value), 6)
        TextBox30.Value = IIf(.Cells(行位置, 121).Value > 0, .Cells(行位置, 121).Value, .Cells(行位置, 18).Value * 1000) '金銭
        TextBox31.Value = 0   '現物
        TextBox32.Value = TextBox30.Value '計
        If .Cells(行位置, 39).Value = "" Then '被扶養者がいなかったら
            ComboBox3.Value = "0"
            Else
            ComboBox3.Value = "1"
        End If
    End With
End Sub
Private Sub CheckBox1_Click()
'被保険者番号を表示する
    If CheckBox1.Value = True Then
        TextBox6.Enabled = False
        TextBox6.BackColor = &H8000000F
    Else
        TextBox6.Enabled = True
        TextBox6.BackColor = &H80000005
    End If
    
End Sub
Private Sub CommandButton9_Click()
    Dim 行 As Integer
    Dim i As Long
    Dim Msg As Integer

'    On Error GoTo ERRORCHECK
        If CommandButton9.caption = "登録" And ListBox1.ListIndex = -1 Then
            MsgBox "リストが選択されていません", 16, AAA
            Exit Sub
        End If
        If CommandButton9.caption = "変更" And ListBox2.ListIndex = -1 Then
            MsgBox "リストが選択されていません", 16, AAA
            Exit Sub
        End If
        Application.Calculation = xlManual
        
'    書き込み事前準備
        With Worksheets("SHFD0006")
            If CommandButton9.caption = "登録" Then
                For i = 0 To 1000
                    If .Cells(6 + i, 1).Value = "" Then
                        Exit For
                    End If
                    If .Cells(6 + i, 6).Value = TextBox7.Value Then
                      Msg = MsgBox("同名の人が既に登録されています。別人の場合は「OK」をクリックしてください。", 1 + 48, "登録")
                        If Msg = 1 Then
                            Exit For
                        Else
                            Exit Sub
                        End If
                    End If
                Next
            End If
'       データチェック エラーだったらnnは1
            Check
            If nn = 1 Then
                Exit Sub
            End If

'       SFFD0006１列目に取得届コードを書き込んでからデータを書き込む
            If CommandButton9.caption = "登録" Then
                行 = .Cells(20000, 1).End(xlUp).Row + 1 '行数の数え方を変更040802
                Else
                行 = ListBox2.ListIndex + 6
            End If
            .Cells(行, 1).Value = "22007041"
            For i = 2 To 36
                If i = 10 Then
                    .Cells(行, i).Value = ComboBox2.Value
                    ElseIf i = 11 Then
                        .Cells(行, i).Value = ComboBox1.Value
                    ElseIf i = 32 Then
                        .Cells(行, i).Value = ComboBox3.Value
                    ElseIf i = 5 Then
                        If CheckBox1.Value = False Then
                            .Cells(行, i).Value = TextBox6.Value
                            Else
                            .Cells(行, i).Value = ""
                        End If
                    ElseIf i = 14 Or i = 27 Or i = 28 Or i >= 19 And i <= 24 Or i >= 33 And i <= 35 Then
                    '20090810 kon
                    ElseIf i = 36 Then
                    .Cells(行, i).Value = カンマ削除(Me.Controls("TextBox" & i + 1).Value)
                    Else
                    .Cells(行, i).Value = Me.Controls("TextBox" & i + 1).Value
                End If
            Next
            .Cells(行, 37).Value = "Q" '改行印
            
        End With
        
        Application.Calculation = xlAutomatic
        
        MsgBox CommandButton9.caption & "しました", 64, AAA
    
    Exit Sub
ERRORCHECK:
       MsgBox Error(Err), , "エラー"
End Sub
Private Sub CommandButton2_Click()
    If ListBox2.ListIndex = -1 Then
        MsgBox "データが選択されていません。", 16, AAA
    Else
        Dim Msg As Integer
        Msg = MsgBox("削除しますか？", 1 + 32, "削除")
        If Msg = 1 Then
            Dim 行 As Integer
            行 = ListBox2.ListIndex + 6
            Worksheets("SHFD0006").Rows(行).Delete Shift:=xlUp
            ListBox2.RemoveItem ListBox2.ListIndex
            MsgBox "削除しました", 64, "削除"
        End If
    End If
End Sub
Private Sub CommandButton3_Click()
    
    Dim i As Long

    If CommandButton3.caption = "変更へ" Then
        ListBox2.Visible = True
        ListBox1.Visible = False
        ''' YBNO20809
        Me.Frame2.Visible = False
        ''' END
        With Worksheets("SHFD0006")
            For i = 0 To 10000
                If .Cells(6 + i, 1).Value = "" Then
                    Exit For
                End If
                ListBox2.AddItem .Cells(6 + i, 26).Value
                ListBox2.List(i, 1) = .Cells(6 + i, 6).Value
            Next
        End With
        CommandButton9.caption = "変更"
        CommandButton9.BackColor = &HC0FFFF
        CommandButton2.Enabled = True
        CommandButton3.caption = "登録へ"
    Else
        ListBox2.Clear
        ListBox2.Visible = False
        ListBox1.Visible = True
        ''' YBNO20809
        Me.Frame2.Visible = True
        ''' END
        CommandButton9.caption = "登録"
        CommandButton9.BackColor = &HFFFF80
        CommandButton2.Enabled = False
        CommandButton3.caption = "変更へ"
    End If
End Sub
Private Sub CommandButton8_Click()

    Dim i As Long

'    検索
    If ListBox1.ListCount = 0 Then
        MsgBox "データがありません。", 16, "検索"
        Exit Sub
    End If
    ListBox3.Clear
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.List(i, 0) Like "*" & TextBox38.Value & "*" Then
           社取得.ListBox3.AddItem ListBox1.List(i, 0)
           社取得.ListBox3.List(社取得.ListBox3.ListCount - 1, 1) = ListBox1.List(i, 2)
        End If
    Next
    If ListBox3.ListCount = 0 Then
        MsgBox "該当する氏名はみつかりませんでした。", 16, "検索"
        Else
        ListBox3.ListIndex = 0
    End If
End Sub
Private Sub TextBox30_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'    報酬による金額
    TextBox32.Value = Val(TextBox30.Value) + Val(TextBox31.Value)
End Sub
Private Sub TextBox31_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'    合計の数値
    TextBox32.Value = Val(TextBox30.Value) + Val(TextBox31.Value)
End Sub
Private Sub CommandButton10_Click()
    社労士切替.Show
End Sub
Private Sub CommandButton11_Click()
    '会社情報.Show
End Sub
Private Sub ListBox2_Click()

    Dim i As Long

'    リストボックス2は変更用
    With Worksheets("SHFD0006")
        For i = 2 To 36
            If i = 10 Then
                ComboBox2.Value = .Cells(ListBox2.ListIndex + 6, i).Value
                ElseIf i = 11 Then
                    ComboBox1.Value = .Cells(ListBox2.ListIndex + 6, i).Value
                ElseIf i = 32 Then
                    ComboBox3.Value = .Cells(ListBox2.ListIndex + 6, i).Value
                ElseIf i = 14 Or i = 27 Or i = 28 Or i >= 19 And i <= 24 Or i >= 33 And i <= 35 Then
                Else
                Me.Controls("TextBox" & i + 1).Value = .Cells(ListBox2.ListIndex + 6, i).Value
            End If
        Next
    End With
End Sub
Private Sub CommandButton13_Click()
    
    Dim CSVFolder As String

    CSVFolder = Application.Run("EAppCom.xla!CreateCSVFile", ThisWorkbook)
    Application.Run "EAppCom.xla!SICheckProc", CSVFolder, Me.CheckBox2.Value, ThisWorkbook

'    'チェックプログラム起動
'    Dim buf As String
'    Application.ScreenUpdating = False
'
'    'SHFD0006フォルダの中に会社名でフォルダを作成
'    Dim strPathName As String
'    strPathName = Dir(ThisWorkbook.path & "\SHFD0006\" & Worksheets("DATA").Cells(26, 2).Value, 16)
'    If strPathName = "" Then MkDir ThisWorkbook.path & "\SHFD0006\" & Worksheets("DATA").Cells(26, 2).Value
'
'    Call SHFD0006作成
'    buf = ThisWorkbook.path & "\SHFD0006\" & Worksheets("DATA").Cells(26, 2).Value
'
'    Dim Obj As Object
'
'    Set Obj = CreateObject("Scripting.FileSystemObject")
'
'    Obj.CopyFolder buf, Environ("TEMP") & "\Cells\"
'
'    Call チェックプログラム起動(Environ("TEMP") & "\Cells\" & Worksheets("DATA").Cells(26, 2).Value)
'    CopyText (Environ("TEMP") & "\Cells\" & Worksheets("DATA").Cells(26, 2).Value)
'
'    Worksheets("社ＣＳＶ").Select
'    Worksheets("DATA").Cells(15, 2).Value = "作成済"
'    Application.ScreenUpdating = True
'
'    Set Obj = Nothing
    
End Sub
Sub SHFD0006作成()
        Dim MyBuf() As String, NewFn As String
        Dim Ro As Long, k As Long, EndR As Long
        Dim C As Range
        Dim Fnum As Integer
        Dim n As Long
        
        n = 1
        Sheets("SHFD0006").Select
        NewFn = ThisWorkbook.path & "\SHFD0006\" & Worksheets("DATA").Cells(26, 2).Value & "\SHFD0006"
        If NewFn = "" Then Exit Sub
        EndR = Cells(65536, 1).End(xlUp).Row
        For Ro = 1 To EndR
                ReDim Preserve MyBuf(n)
                For Each C In Range(Cells(Ro, 1), Cells(Ro, 256).End(xlToLeft))
                    If C.Column = 1 Then
                        MyBuf(n) = C.Value
                        ElseIf C.Value = "Q" Then
                        Else
                        If n = 3 Then
                            '事業所数は強制的に1件とする
                            MyBuf(n) = MyBuf(n) & "," & "001"
                            Else
                            MyBuf(n) = MyBuf(n) & "," & C.Value
                        End If
                    End If
                Next C
                n = n + 1
        Next Ro
        
        If n <= 6 Then
            Else
            Fnum = FreeFile()
            Open NewFn & ".csv" For Output As #Fnum
                For k = LBound(MyBuf) To UBound(MyBuf)
                    If k = 0 Then
                        Else
                        Print #Fnum, MyBuf(k)

                    End If
                Next k
            Close #Fnum
            Erase MyBuf
        End If

End Sub
Sub チェックプログラム起動(ByVal CSVpath As String)
On Error GoTo ERRORCHECK
        Dim MyStr    As String
        Dim PathName As String
        Dim i As Long
        Dim FileName As String
        
        
'        チェックプログラムパス取得 20120611masa 3パターンでパスを取得する
        If "KSlfChk.exe" = Dir("C:\Program Files (x86)\ShSlfChk\KSlfChk.exe") Then
            MyStr = "C:\Program Files (x86)\ShSlfChk\KSlfChk.exe"
        ElseIf "KSlfChk.exe" = Dir("C:\Program Files\ShSlfChk\KSlfChk.exe") Then
            MyStr = "C:\Program Files\ShSlfChk\KSlfChk.exe"
        Else
            FileName = Worksheets("DATA").Cells(2, 2).Value
            Open FileName For Input As #1
                For i = 1 To 38
                    Input #1, MyStr
                    'PathName = MyStr
                Next
            Close #1
        End If
        PathName = MyStr
        
        
        If CheckBox2.Value = True Then
        ''' YBNO 255 64bit対応 笹原
            If ShellExecute(0, "open", MyStr, vbNull, vbNull, SW_NORMAL) <= 32 Then
                Err.Raise 53
            End If
        '    Shell MyStr, 1
        ''' END YBNO 255 64bit対応 笹原
            Exit Sub
        End If
        
                
        '起動していない場合は、動かす
        Dim hwnd As Long
        Dim CaptionString As String
        If Not IsExistWindowCheckTool(CaptionString, hwnd) Then
'        If Not IsExistWindow("仕様チェックプログラム(Version4.00)", hWnd) Then
            ExecCmd MyStr, False
            Sleep 4500
            IsExistWindowCheckTool CaptionString, hwnd 'もうウインドウ一度とる
            '注意画面が出てるか調べる
            If IsExistWindow("注意", hwnd) Then
                '出ていたらボタンを押す
                ButtonOperation hwnd, "OK"
                Sleep 1500
            End If
            If IsExistWindowCheckTool(CaptionString, hwnd) = False Then GoTo ERRORCHECK
            IsExistWindowCheckTool CaptionString, hwnd 'もうウインドウ一度とる
        End If
        Sleep 1500
        'ラジオボタン
        ButtonOperation hwnd, "電子申請"
        TextBoxOperation hwnd, CSVpath
        ButtonOperation hwnd, "チェック"
        Exit Sub
ERRORCHECK:
        MsgBox "チェックプログラムがインストールされていないか、ファイルが見つかりません", 16, "エラー"
        MyStr = ""
        Close #1
        Worksheets("DATA").Cells(15, 2).Value = ""
        
End Sub
Sub Check()
nn = 0
If 半角数値(TextBox3.text) = 2 Then
Else
MsgBox "「事業所整理記号」(半角数字2文字)が不正です", 16, "入力規則エラー"
nn = 1
Exit Sub
End If

If 半角文字(TextBox4.text) >= 1 And 半角文字(TextBox4.text) <= 4 Then
Else
MsgBox "「事業所整理記号」(半角文字4文字以内)が不正です", 16, "入力規則エラー"
nn = 1
Exit Sub
End If

If 半角数値(TextBox5.text) >= 1 And 半角数値(TextBox5.text) <= 5 Then
Else
MsgBox "「事業所番号」(半角数字5文字以内)が不正です", 16, "入力規則エラー"
nn = 1
Exit Sub
End If

If TextBox6.text = "" Or 半角数値(TextBox6.text) >= 1 And 半角数値(TextBox6.text) <= 6 Then
Else
MsgBox "「被保険者整理番号」(省略または半角数字6文字以内)が不正です", 16, "入力規則エラー"
nn = 1
TextBox6.SetFocus
TextBox6.SelStart = 0
TextBox6.SelLength = Len(TextBox6.text)
Exit Sub
End If


If 文字判定(TextBox7.text) = 2 And 半角カナ(TextBox7.text) >= 1 And 半角カナ(TextBox7.text) <= 25 And スペース(TextBox7.text) = 1 Then
Else
MsgBox "「被保険者氏名（カナ）」(半角ｶﾀｶﾅ25文字以内)が不正です", 16, "入力規則エラー"
nn = 1
TextBox7.SetFocus
TextBox7.SelStart = 0
TextBox7.SelLength = Len(TextBox7.text)
Exit Sub
End If

If TextBox8.text = "" Or 無効文字(TextBox8.text) = 0 And 文字判定(TextBox8.text) = 1 And Len(TextBox8.text) <= 12 And Len(TextBox8.text) >= 1 And スペース(TextBox8.text) = 1 Then
Else
MsgBox "「被保険者氏名（漢字）」（全角12文字以内）が不正です", 16, "入力規則エラー"
nn = 1
TextBox8.SetFocus
TextBox8.SelStart = 0
TextBox8.SelLength = Len(TextBox8.text)
Exit Sub
End If

If TextBox9.text = "1" Or TextBox9.text = "3" Or TextBox9.text = "5" Or TextBox9.text = "7" Then
Else
MsgBox "「生年月日の元号」(半角数字1,3,5,7のみ)が不正です", 16, "入力規則エラー"
nn = 1
TextBox9.SetFocus
TextBox9.SelStart = 0
TextBox9.SelLength = Len(TextBox9.text)
Exit Sub
End If


If 半角数値(TextBox10.text) = 6 Then
Else
MsgBox "「生年月日の年月日」(半角数字６文字)が不正です", 16, "入力規則エラー"
nn = 1
TextBox10.SetFocus
TextBox10.SelStart = 0
TextBox10.SelLength = Len(TextBox10.text)
Exit Sub
End If

If ComboBox2.Value >= 1 And ComboBox2.Value <= 3 Or ComboBox2.Value >= 5 And ComboBox2.Value <= 7 Then
Else
MsgBox "「種別（性別）」(半角数字1,2,3,5,6,7のみ)が不正です", 16, "入力規則エラー"
nn = 1
ComboBox2.SetFocus
Exit Sub
End If

If ComboBox1.Value = "" Or ComboBox1.Value >= 0 And ComboBox1.Value <= 4 Then
Else
MsgBox "「取得原因」(半角数字0,1,2,3,4のみ)が不正です", 16, "入力規則エラー"
nn = 1
ComboBox1.SetFocus
Exit Sub
End If

If TextBox13.text = "" And TextBox14.text = "" Or 半角数値(TextBox13.text) = 4 Then
Else
MsgBox "「基礎年金番号」(省略または半角数字4文字)が不正です", 16, "入力規則エラー"
nn = 1
TextBox13.SetFocus
TextBox13.SelStart = 0
TextBox13.SelLength = Len(TextBox13.text)
Exit Sub
End If

If TextBox13.text = "" And TextBox14.text = "" Or 半角数値(TextBox14.text) = 6 Then
Else
MsgBox "「基礎年金番号」(省略または半角数字6文字)が不正です", 16, "入力規則エラー"
nn = 1
TextBox14.SetFocus
TextBox14.SelStart = 0
TextBox14.SelLength = Len(TextBox14.text)
Exit Sub
End If

If 半角数値(TextBox16.text) = 3 Then
Else
MsgBox "「郵便番号」(省略または半角数字3文字)が不正です", 16, "入力規則エラー"
nn = 1
TextBox16.SetFocus
TextBox16.SelStart = 0
TextBox16.SelLength = Len(TextBox16.text)
Exit Sub
End If

If 半角数値(TextBox17.text) = 4 Then
Else
MsgBox "「郵便番号」(省略または半角数字4文字)が不正です", 16, "入力規則エラー"
nn = 1
TextBox17.SetFocus
TextBox17.SelStart = 0
TextBox17.SelLength = Len(TextBox17.text)
Exit Sub
End If

If TextBox18.text = "" Or 文字判定(TextBox18.text) = 2 And 半角文字(TextBox18.text) >= 1 And 半角文字(TextBox18.text) <= 75 Then
Else
MsgBox "「住所（カナ）」（半角英数ｶﾅ75文字以内）が不正です", 16, "入力規則エラー"
nn = 1
TextBox18.SetFocus
TextBox18.SelStart = 0
TextBox18.SelLength = Len(TextBox18.text)
Exit Sub
End If

If TextBox19.text = "" Or 無効文字(TextBox19.text) = 0 And 半角スペース(TextBox19.text) = 0 And Len(TextBox19.text) <= 37 And Len(TextBox19.text) >= 1 Then
Else
MsgBox "「住所（漢字）」（全角文字37文字以内）が不正です", 16, "入力規則エラー"
nn = 1
TextBox19.SetFocus
TextBox19.SelStart = 0
TextBox19.SelLength = Len(TextBox19.text)
Exit Sub
End If

If TextBox26.text = "5" Or TextBox26.text = "7" Then
Else
MsgBox "「資格取得年月日の元号」(半角数字5,7のみ)が不正です", 16, "入力規則エラー"
nn = 1
TextBox26.SetFocus
TextBox26.SelStart = 0
TextBox26.SelLength = Len(TextBox26.text)
Exit Sub
End If


If 半角数値(TextBox27.text) = 6 Then
Else
MsgBox "「資格取得年月日の年月日」(半角数字6文字)が不正です", 16, "入力規則エラー"
nn = 1
TextBox27.SetFocus
TextBox27.SelStart = 0
TextBox27.SelLength = Len(TextBox27.text)
Exit Sub
End If


If 半角数値(TextBox30.text) >= 1 And 半角数値(TextBox30.text) <= 7 Then
Else
MsgBox "「金銭によるものの額」(半角数字7文字以内)が不正です", 16, "入力規則エラー"
nn = 1
TextBox30.SetFocus
TextBox30.SelStart = 0
TextBox30.SelLength = Len(TextBox30.text)
Exit Sub
End If

If 半角数値(TextBox31.text) >= 1 And 半角数値(TextBox31.text) <= 7 Then
Else
MsgBox "「金銭によるものの額」(半角数字7文字以内)が不正です", 16, "入力規則エラー"
nn = 1
TextBox31.SetFocus
TextBox31.SelStart = 0
TextBox31.SelLength = Len(TextBox31.text)
Exit Sub
End If

If 半角数値(TextBox32.text) >= 1 And 半角数値(TextBox32.text) <= 7 Then
Else
MsgBox "「合計」(半角数字7文字以内)が不正です", 16, "入力規則エラー"
nn = 1
TextBox32.SetFocus
TextBox32.SelStart = 0
TextBox32.SelLength = Len(TextBox32.text)
Exit Sub
End If

If 無効文字(TextBox37.text) = 0 And LenMbcs(TextBox37.text) >= 0 And LenMbcs(TextBox37.text) <= 75 Then
Else
MsgBox "「備考」（全角文字37文字(半角75文字）以内）が不正です", 16, "入力規則エラー"
nn = 1
TextBox37.SetFocus
TextBox37.SelStart = 0
TextBox37.SelLength = Len(TextBox37.text)
Exit Sub
End If

If ComboBox3.Value = "1" Or ComboBox3.Value = "0" Then
Else
MsgBox "「被扶養者の有無」(半角数字1,0のみ)が不正です", 16, "入力規則エラー"
nn = 1
ComboBox3.SetFocus
Exit Sub
End If







End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.Calculation = xlAutomatic
'If Label23.Caption <> "" Then
'Workbooks(Label23.Caption & "da.xls").Close False
'ThisWorkbook.Activate
'End If
End Sub

Attribute VB_Name = "Function1"
Option Explicit
Public Const AAA As String = "取得届"
Dim i As Integer
Dim n As Integer
Dim strg1 As String
'本当のバイト数
Function LenMbcs(ByVal str As String)
    LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function
'半角カナの数
Function 半角カナ(strg As String)

n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If Asc(strg1) <= 223 And Asc(strg1) >= 166 Then
n = n + 1
End If
Next
半角カナ = n
End Function
'半角数値の数(「-」含む）
Function 半角数値(strg As String)
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If Asc(strg1) <= 57 And Asc(strg1) >= 48 Or Asc(strg1) = 45 Then
n = n + 1
End If
Next
半角数値 = n
End Function
'半角文字の数
Function 半角文字(strg As String)
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If Asc(strg1) < 256 And Asc(strg1) >= 0 Then
n = n + 1
End If
Next
半角文字 = n
End Function
Function 無効文字(strg As String)
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If Asc(strg1) < 0 Then
If Asc(strg1) > -5468 Then
n = n + 1
End If
End If
Next
無効文字 = n
End Function
Function スペース(strg As String)
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If strg1 = " " Or strg1 = "　" Then
n = n + 1
End If
Next
スペース = n
End Function
Function 半角スペース(strg As String)
n = 0
For i = 1 To Len(strg)
strg1 = Mid(strg, i, 1)
If strg1 = " " Then
n = n + 1
End If
Next
半角スペース = n
End Function
Function 文字判定(strUnicode As String)
          Dim strANSI As String
          Dim lchar As Integer, lbyte As Integer
          strANSI = StrConv(strUnicode, vbFromUnicode)
          lchar = Len(strUnicode)
          lbyte = LenB(strANSI)
          If lchar * 2 = lbyte Then
              文字判定 = 1 '全角文字のみ
          ElseIf lchar = lbyte Then
              文字判定 = 2 '半角文字のみ
          Else
              文字判定 = 3 '混在
          End If
End Function

Function Mydate(セル As Variant)
If セル = "" Then
 Mydate = ""
 Else
 If セル >= 32516 Then
 Mydate = 7
 ElseIf セル >= 9856 Then
 Mydate = 5
 ElseIf セル >= 4595 Then
 Mydate = 3
 Else
 Mydate = 1
 End If
Mydate = Mydate & "-" & Format(セル, "ee") & Format(セル, "mm") & Format(セル, "dd")
End If
End Function
Function Mydate2(text As Variant)
If text = "" Then
 Mydate2 = ""
 Else
 If Mid(text, 1, 1) = 7 Then
 Mydate2 = 1988
 ElseIf Mid(text, 1, 1) = 5 Then
 Mydate2 = 1925
 ElseIf Mid(text, 1, 1) = 3 Then
 Mydate2 = 1911
 Else
 Mydate2 = 1867
 End If
Mydate2 = DateSerial(Mid(text, 3, 2) + Mydate2, Mid(text, 5, 2), Mid(text, 7, 2))
End If
End Function
Function 社TEL(Denwa As String)
            Dim j As Integer
            Dim k As Integer
            Dim l As Integer
            j = 0
            k = 0
            With Worksheets("社総括票")
                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 'ＴＥＬ１
                    .Cells(32, 2).Value = Denwa
                    Exit Function
                    Else
                    .Cells(32, 2).Value = Mid(Denwa, 1, j - 1)
                End If
                If k = 0 Then 'ＴＥＬ2
                    .Cells(33, 2).Value = Mid(Denwa, j + 1, Len(Denwa) - j)
                    Exit Function
                    Else
                    .Cells(33, 2).Value = Mid(Denwa, j + 1, k - j - 1)
                End If
                .Cells(34, 2).Value = Mid(Denwa, k + 1, Len(Denwa) - k) 'ＴＥＬ3
            End With
End Function
Function 雇TEL(Denwa As String, Cell As Integer)
            Dim j As Integer
            Dim k As Integer
            Dim l As Integer
            j = 0
            k = 0
            With Worksheets("雇総括票")
                For l = 1 To Len(Denwa)
                    If Mid(Denwa, l, 1) = "-" Then
                        If j = 0 Then
                            j = l
                            Else
…