Option Explicit
'ファイル関連クラス
'プロパティは、メンバー以外アクセスできない

'プロイパティの実体
Private mstrName As String      'ファイル名
Private mstrDir As String       'カレントディレクトリ値
Private mintMojisu As Integer   'ディレクトリの文字数
Private mvntName As Variant     'ダイアログ値
Private mwbNew As Workbook      'ワークブック

Public Property Get Name() As String

    Name = mstrName
    
End Property

Public Property Let Name(ByVal strName As String)

    mstrName = strName
    
End Property

'新規作成メソッド
Public Sub AddWorkBook()

    Dim objws As Worksheet      'ワークシート
    Dim intMsg As Integer       'メッセージボックスからの戻り値
    Dim bytPos As Byte          '検査値
    Dim intCnt As Integer       'ワークシート数
    
    Set mwbNew = Workbooks.Add
        
    '新規作成ダイアログボックス表示
    mvntName = Application.GetSaveAsFilename("", "Excel(*.xls),*.xls", 0, "新規作成")
    
    'データブックを非表示
    If ActiveWindow.Visible = True Then ActiveWindow.Visible = False
        
    'ダイアログボックスのボタン値の検査
    If mvntName = False Then GoTo CancelPrc
    
    '同じファイル名の検査
    If Dir(CStr(mvntName)) <> "" Then GoTo ErrorPrc
    
CreateData:

    'ワークシート数の取得
    intCnt = mwbNew.Worksheets.Count
    If intCnt < 11 Then mwbNew.Worksheets.Add , , 11 - intCnt
    
    'カレントディレクトリ給与計算システムを更新
    mstrDir = CurDir
    'ディレクトリの文字数を取得
    mintMojisu = Len(mstrDir)
    '変数にデータを格納
    mwbNew.SaveAs CStr(mvntName)
    mstrName = CStr(Mid$(mvntName, mintMojisu + 2))
    'システム基礎情報を書き込む
    Set objws = Workbooks(mstrName).Worksheets("Sheet1")
    objws.Cells(1, 1).Value = "copyright(c) 2000 keisuke all rights reserved"
    Set objws = Nothing
    
    Exit Sub
    
CancelPrc:
'キャンセル時の処理
    mvntName = ""
    mwbNew.Close False
    ChDir mstrDir
    Exit Sub
    
ErrorPrc:
'同じファイル名を指定したとき

    intMsg = MsgBox("すでに同じファイル名があります。" & vbCrLf & "上書きしますか。", 32 + 4, "給与計算")
    
    '「はい」が選択されたとき
    If intMsg = 6 Then
        '拡張子を検査
        bytPos = InStr(CStr(mvntName), ".xls")
        'ファイル削除
        If bytPos = 0 Then Kill CStr(mvntName) & ".xls"
        If bytPos <> 0 Then Kill CStr(mvntName)
        '保存
        GoTo CreateData
    Else
        GoTo CancelPrc
    End If
    
End Sub

'開くメソッド
Public Sub OpenWorkBook()

    Dim objws As Worksheet  'ワークシート
        
    mvntName = Application.GetOpenFilename("Excel(*.xls),*.xls", 0, "開く", , False)
    
    'ダイアログボックスのボタンの検査
    'キャンセル
    If mvntName = False Then
        GoTo CancelPrc
    
    'ＯＫボタン
    Else
        'カレントディレクトリを更新
        mstrDir = CurDir
        'ディレクトリの文字数を取得
        mintMojisu = Len(mstrDir)
        '変数にデータを格納
        mstrName = CStr(Mid$(mvntName, mintMojisu + 2))
        Workbooks.Open CStr(mvntName)
        'データファイルの整合性の検査
        On Error GoTo ErrorProc
        Set objws = Workbooks(mstrName).Worksheets("Sheet1")
        If objws.Cells(1, 1).Value <> "copyright(c) 2000 keisuke all rights reserved" Then GoTo ErrorProc
        On Error GoTo 0
        On Error Resume Next
        If ActiveWindow.Visible = True Then ActiveWindow.Visible = False
    End If
        
    Set objws = Nothing
    
    Exit Sub
    
CancelPrc:
'キャンセル時の処理
    mvntName = ""
    ChDir mstrDir
    
    Exit Sub
    
ErrorProc:

    MsgBox "「xlKyuyo2」のデータファイルでないか、ファイルが壊れています。" & vbCrLf & "選択し直して下さい。", _
            16 + 0, "給与計算システム"
    
    Workbooks(mstrName).Close False
    gstrName = ""
    mstrName = ""
End Sub

'閉じるメソッド
Public Sub CloseWorkBook()

    Dim intMsg As Integer   'メッセージの戻り値
        
    'ブック名の取得
    mvntName = mstrName
    '変更の有無に応じ保存
    If Workbooks(CStr(mvntName)).Saved = False Then
        intMsg = MsgBox("保存してから閉じますか。", 32 + 4, "給与計算システム")
        If intMsg = 6 Then
            Workbooks(CStr(mvntName)).Close True
        Else
            intMsg = MsgBox("変更した内容は保存されません。" & vbCrLf & "本当に閉じますか。", 32 + 4, "給与計算システム")
            If intMsg = 6 Then
                Workbooks(CStr(mvntName)).Close False
            Else
                Exit Sub
            End If
        End If
    Else
        Workbooks(mvntName).Close False
    End If
    
    ChDir mstrDir
    
End Sub

'名を付けて保存メソッド
Public Sub RenameWorkBook()

    Dim intMsg As Integer   'メッセージの戻り値
    Dim bytPos As Byte      '検査値
    
    'ブック名の取得
    Set mwbNew = Workbooks(mstrName)
        
    '名を付けて保存ダイアログボックスを表示
    mvntName = Application.GetSaveAsFilename(, "Excel(*.xls),*.xls", , "名を付けて保存")
    
    'ダイアログボックスのボタン値の検査
    If mvntName = False Then GoTo CancelPrc
    
    '同じファイル名の検査
    If Dir(CStr(mvntName)) <> "" Then GoTo ErrorPrc
    
    'ファイル保存
    mwbNew.SaveAs CStr(mvntName)
    
    '変数にデータを格納
    mstrName = CStr(mvntName)
    Exit Sub
    
CancelPrc:
'キャンセル時の処理
    mvntName = ""
    ChDir mstrDir
    Exit Sub
    
ErrorPrc:
'同じファイル名を指定したとき

    intMsg = MsgBox("すでに同じファイル名があります。" & vbCrLf & "上書きしますか。", 32 + 4, "給与計算")
    
    '「はい」が選択されたとき
    If intMsg = 6 Then
        '拡張子を検査
        bytPos = InStr(CStr(mvntName), ".xls")
        'ファイル削除
        If bytPos = 0 Then Kill mvntName & ".xls"
        If bytPos <> 0 Then Kill mvntName
        '保存
        mwbNew.SaveAs CStr(mvntName)
    Else
        mvntName = ""
    End If
    
End Sub

'上書き保存
Public Sub SaveWorkbook()
    
    'ブックの取得
    mstrName = gstrName
    
    '保存
    On Error Resume Next
    mwbNew.SaveAs CStr(mstrName)
        
End Sub

'ファイルクラスインスタンス時の動作
Private Sub Class_Initialize()

    'カレントディレクトリの取得
    mstrDir = CurDir
    
    'ディレクトリの文字数を取得
    mintMojisu = Len(mstrDir)
    
End Sub

'ファイルクラスの開放時
Private Sub Class_Terminate()

    Set mwbNew = Nothing
    
End Sub