Option Explicit

'===========================================================
'  *ブック制御クラス
'
'  Ver  1.0
'
'  #ref(Z_cBookControl_1.0.txt)
'  #ref(cBookControl_1.0.txt)
'
'  **コンストラクタ
'  Private Sub Class_Initialize()
'  **初期化
'  Public Function Initialize()
'  **ステータス取得
'  Public Function getStatus()
'
'  **Excelユーザ名取得
'  Public Function getExcelUserName()
'  **Excel組織名取得
'  Public Function getExcelOrganizationName()
'  **Excelメモリ情報取得
'  Public Function getExcelMemory()
'  **ステータスバー制御開始
'  Public Function StatusBarStart()
'  **ステータスバー表示
'  Public Function StatusBarPut()
'  **ステータスバー制御終了
'  Public Function StatusBarEnd()
'  **カーソル処理中
'  Public Function CursorWait()
'  **画面更新中止
'  Public Function DisplayUpdateStop()
'  **画面更新開始
'  Public Function DisplayUpdateStart()
'  **カーソル通常
'  Public Function CursorNormal()
'  **ファイル選択ダイアログ
'  Public Function getFileNameByDialog()
'  **指定ブックオープン済チェック
'  Public Function isCheckOpenSelectBook()
'  **Excelタイトル変更
'  Public Function setExcelTitle()
'  **Excelタイトル変更停止
'  Public Function unsetExcelTitle()
'
'  **終了
'  Public Function Terminate()
'  **デコンストラクタ
'  Private Sub Class_Terminate()
'  **Excel終了時処理
'  Private Sub foExcelApplication_WorkbookBeforeClose()
'  **フィールドクリア
'  Private Sub clearField()
'===========================================================

'処理前ステータスバー
Private fvStatusBarSave As Variant
'ステータスバー制御開始済フラグ
Private fbStatusBarStart As Boolean
'Excelタイトル設定中フラグ
Public fbExcelTitleSet As Boolean
'Excelタイトル変更前
Private fsExcelTitleSave As String
'Initialize済フラグ
Private fbInitialize As Boolean

Private WithEvents foExcelApplication As Excel.Application

'#
'# コンストラクタ
'#
Private Sub Class_Initialize()

  Set foExcelApplication = Excel.Application

  Call clearField

End Sub

'#
'# 初期化
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function Initialize( _
  ) As Boolean

  Dim lbRet As Boolean
  
  '#初期化済でないこと
  If (fbInitialize <> False) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    fbInitialize = True
  End If
  
  Initialize = lbRet

End Function

'#
'# ステータス取得
'#   [戻り値]:
'#     String
'#       CSV形式でプライベート変数内容を返却
'#   [引  数]:
'#     なし
'#
Public Function getStatus( _
  ) As String

  Dim lsRet As String

  lsRet = _
    "fbInitialize=" & fbInitialize & _
    ",fvStatusBarSave=" & fvStatusBarSave & _
    ",fbStatusBarStart=" & fbStatusBarStart & _
    ",fsExcelTitleSave=" & fsExcelTitleSave & _
    ",fbExcelTitleSet=" & fbExcelTitleSet

  getStatus = lsRet

End Function

'#
'# Excelユーザ名取得
'#   [戻り値]:
'#     String
'#       Excelユーザ名
'#   [引  数]:
'#     なし
'#
Public Function getExcelUserName( _
  ) As String

  Dim lsRet As String

  lsRet = Application.UserName

  getExcelUserName = lsRet

End Function

'#
'# Excel組織名取得
'#   [戻り値]:
'#     String
'#       Excel組織名
'#   [引  数]:
'#     なし
'#
Public Function getExcelOrganizationName( _
  ) As String

  Dim lsRet As String

  lsRet = Application.OrganizationName

  getExcelOrganizationName = lsRet

End Function

'#
'# Excelメモリ情報取得
'#   [戻り値]:
'#     String
'#   [引  数]:
'#     iiType(Integer)
'#
Public Function getExcelMemory( _
  iiType As Integer _
  ) As String

  Const csExcelMemoryTypeFree As Integer = 0
  Const csExcelMemoryTypeTotal As Integer = 1
  Const csExcelMemoryTypeUsed As Integer = 2
  Const csExcelMemoryTypeUsePer As Integer = 3
  
  Dim lsRet As String

  If (iiType = csExcelMemoryTypeFree) Then
    lsRet = Application.MemoryFree
  ElseIf (iiType = csExcelMemoryTypeTotal) Then
    lsRet = Application.MemoryTotal
  ElseIf (iiType = csExcelMemoryTypeUsed) Then
    lsRet = Application.MemoryUsed
  Else
    lsRet = VBA.Round( _
      (Application.MemoryUsed / Application.MemoryTotal * 100), _
      2 _
    )
  End If
  
  getExcelMemory = lsRet

End Function

'#
'# ステータスバー制御開始
'#   [戻り値]:
'#     Boolean
'#   [引  数]:
'#     なし
'#
Public Function StatusBarStart( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  'ステータスバー制御開始済でないこと
  ElseIf (fbStatusBarStart <> False) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    fvStatusBarSave = Application.StatusBar
    fbStatusBarStart = True
  End If

  StatusBarStart = lbRet

End Function

'#
'# ステータスバー表示
'#   [戻り値]:
'#     Boolean
'#   [引  数]:
'#     lsMsg
'#       表示メッセージ
'#
Public Function StatusBarPut( _
  lsMsg As String _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  'ステータスバー制御開始済であること
  ElseIf (fbStatusBarStart <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    Application.StatusBar = lsMsg
  End If

  StatusBarPut = lbRet

End Function

'#
'# ステータスバー制御終了
'#   [戻り値]:
'#     Boolean
'#   [引  数]:
'#     なし
'#
Public Function StatusBarEnd( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  'ステータスバー制御開始済であること
  ElseIf (fbStatusBarStart <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    Application.StatusBar = fvStatusBarSave
    fbStatusBarStart = False
  End If

  StatusBarEnd = lbRet

End Function

'#
'# カーソル処理中
'#   [戻り値]:
'#     Boolean
'#   [引  数]:
'#     なし
'#
Public Function CursorWait( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    Application.Cursor = xlWait
  End If

  CursorWait = lbRet

End Function

'#
'# 画面更新中止
'#   [戻り値]:
'#     Boolean
'#   [引  数]:
'#     なし
'#
Public Function DisplayUpdateStop( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    Application.ScreenUpdating = False
  End If

  DisplayUpdateStop = lbRet

End Function

'#
'# 画面更新開始
'#   [戻り値]:
'#     Boolean
'#   [引  数]:
'#     なし
'#
Public Function DisplayUpdateStart( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    Application.ScreenUpdating = True
  End If

  DisplayUpdateStart = lbRet

End Function

'#
'# カーソル通常
'#   [戻り値]:
'#     Boolean
'#   [引  数]:
'#     なし
'#
Public Function CursorNormal( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    Application.Cursor = xlDefault
  End If

  CursorNormal = lbRet

End Function

'# ファイル選択ダイアログ
'#    [戻り値]:
'#      Variant
'#        パス付ファイル名
'#        分離した文字は、String()で返却
'#        分離する文字がない場合、Empty値
'#    [引  数]:
'#      isDialogTitle(String)
'#        ダイアログのタイトル
'#      isFileFilterString(String)
'#        ダイアログ中の「ファイルの種類」
'#      ibMultiFileSelect(Boolean)
'#        複数選択の可否
Public Function getFileNameByDialog( _
  isDialogTitle As String, _
  isFileFilterString As String, _
  ibMultiFileSelect As Boolean _
  ) As Variant

  Dim lvRet As Variant
  Dim lsFileNameArray() As String

  Dim lvFileName As Variant
  lvFileName = _
  Application.GetOpenFilename( _
    FileFilter:=isFileFilterString _
    , FilterIndex:=1 _
    , Title:=isDialogTitle _
    , MultiSelect:=ibMultiFileSelect _
  )

  If (ibMultiFileSelect = False) Then
    If lvFileName <> False Then
      ReDim lsFileNameArray(0)
      lsFileNameArray(0) = lvFileName
      lvRet = lsFileNameArray
    End If
  Else
    If IsArray(lvFileName) Then
      Dim liLoopCounter1 As Integer
      For liLoopCounter1 = 0 To UBound(lvFileName) - 1 Step 1
        ReDim Preserve lsFileNameArray(liLoopCounter1)
        lsFileNameArray(liLoopCounter1) = _
          lvFileName(liLoopCounter1 + 1)
      Next
      lvRet = lsFileNameArray
    End If
  End If

  getFileNameByDialog = lvRet

End Function

'# 指定ブックオープン済チェック
'#    [戻り値]:
'#      Boolean
'#        True: オープンしていた
'#        False:オープンしていない
'#    [引  数]:
'#      isChkBookName(String)
'#        ブック名("abc.xls")
Public Function isCheckOpenSelectBook( _
  isChkBookName As String _
  ) As Boolean

  Dim lbRet As Boolean
  lbRet = False
  Dim loOpenBook

  For Each loOpenBook In Workbooks
    If (loOpenBook.Name = isChkBookName) Then
      lbRet = True
      Exit For
    End If
  Next

  isCheckOpenSelectBook = lbRet

End Function

'# Excelタイトル変更
'#    [戻り値]:
'#      Boolean
'#        True: オープンしていた
'#        False:オープンしていない
'#    [引  数]:
'#      isExcelTitle(String)
'#        タイトル内容
Public Function setExcelTitle( _
  isExcelTitle As String _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  'Excelタイトル設定中でないこと
   ElseIf (fbExcelTitleSet <> False) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    Dim lsChkWorkbookNameInc As String
    lsChkWorkbookNameInc = _
      " - " & Right(Application.Caption, Len(ThisWorkbook.Name))
    fsExcelTitleSave = _
      Left( _
        Application.Caption, _
        Len(Application.Caption) - Len(lsChkWorkbookNameInc) _
      )
    Application.Caption = isExcelTitle
    fbExcelTitleSet = True
  End If

  setExcelTitle = lbRet

End Function

'# Excelタイトル変更停止
'#    [戻り値]:
'#      Boolean
'#        True: オープンしていた
'#        False:オープンしていない
'#    [引  数]:
'#      なし
Public Function unsetExcelTitle( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  'Excelタイトル設定中であること
   ElseIf (fbExcelTitleSet <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True

    Application.Caption = fsExcelTitleSave
    fsExcelTitleSave = ""
    fbExcelTitleSet = False
  End If

  unsetExcelTitle = lbRet

End Function

'#
'# 終了
'#   [戻り値]:
'#     Boolean
'#       True: 成功
'#       False:失敗
'#   [引  数]:
'#     なし
'#
Public Function Terminate( _
  ) As Boolean

  Dim lbRet As Boolean

  '#初期化済であること
  If (fbInitialize <> True) Then
    lbRet = False
  '#実行条件適合
  Else
    lbRet = True
    
    Call clearField
  End If

  Terminate = lbRet

End Function

'#
'# デコンストラクタ
'#
Private Sub Class_Terminate()

  Set foExcelApplication = Nothing
  Call Me.Terminate

End Sub

'#
'# Excel終了時処理
'#
Private Sub foExcelApplication_WorkbookBeforeClose( _
  ByVal Wb As Workbook, Cancel As Boolean _
)

  Class_Terminate

End Sub

'#
'# フィールドクリア
'#
Private Sub clearField()
  
  fbInitialize = False
  fbStatusBarStart = False
  fsExcelTitleSave = ""
  fbExcelTitleSet = False

End Sub