【Excel、Access、PowerPoint、Wordマクロ】各OFFICEドキュメント毎、新規作成を行うマクロのサンプル一覧２　バグ修正　コンパイルオプションで参照設定のスイッチフラグ追加

やりだすと、こだわってしまう。。

前回のソースコードの修正版。

バグ修正：オブジェクトを閉じる（.Quit）系の処理がすっぽり抜けていたので追加。

　　　　　　　これは恥ずかしい。。。

機能追加：コンパイルオプションで参照設定のスイッチフラグ追加

このスイッチフラグには利点は２点ある。

１点目は、実行環境に参照設定が無くても実行できること。

２点目は、実行環境に参照設定があると、コードの補完機能（インテリセンス）が使えること。

コードはやや冗長になるけど、保守性と再利用性が高まるのでおすすめ

それと最後にエラーハンドリング用に例外処理用のラベル追加

JAVAとか、C#によくある構文をまねた。

#Const LINK_LIBRATY = 0 ‘参照設定あり(1)/参照設定なし(0)
‘LINK_LIBRATY = 1 の場合　参照設定にてexcel,word,powerpoint,AccessのLibraryを追加する。
‘確認環境はoffice2010で参照Libraryとバージョンは以下のとおり
‘①Excel   Microsoft Excel 14.0 Object Library
‘②Access  Microsoft Access 14.0 Object Library
‘③PowerPoint  Microsoft PowerPoint 14.0 Object Library
‘④Word    Microsoft Word 14.0 Object Library
Sub 各OFFICEドキュメントの新規作成マクロ()
    On Error GoTo EXCEPTION
   
    ‘以下ソースコード
    ‘SavePath配下にSaveName(+各ドキュメント毎の拡張子)のファイルが作成される。
    Dim SavePath As String
    Dim SaveName As String
    SavePath = "C:\test\"
    SaveName = "testData"
    If Dir(SavePath, vbDirectory) = "" Then
        MkDir SavePath
    End If
   
   
    ‘Excelの新規作成
#If LINK_LIBRATY Then ‘ 参照設定あり
    Dim xlsApp As Excel.Application
    Set xlsApp = New Excel.Application
    Dim wb As Excel.Workbook
#Else ‘参照設定なし
    Dim xlsApp As Object
    Set xlsApp = CreateObject("Excel.Application")
    Dim wb As Object
#End If
    Set wb = xlsApp.Workbooks.Add
    wb.Saved = True
    Call wb.SaveAs(SavePath & SaveName)
    Debug.Print wb.Path
    wb.Close
       
    ‘Wordの新規作成
#If LINK_LIBRATY Then ‘参照設定あり
    Dim docApp As Word.Application
    Set docApp = New Word.Application
    Dim doc As Word.Document
#Else ‘参照設定なし
    Dim docApp As Object
    Set docApp = CreateObject("Word.Application")
    Dim doc As Object
#End If
    Set doc = docApp.Documents.Add
    Call doc.SaveAs2(SavePath & SaveName)
    Debug.Print doc.Path
    doc.Close
       
    ‘PowerPointの新規作成
#If LINK_LIBRATY Then ‘参照設定あり
    Dim pptApp As PowerPoint.Application
    Set pptApp = New PowerPoint.Application
    Dim pre As PowerPoint.Presentation
#Else ‘参照設定なし
    Dim pptApp As Object
    Set pptApp = CreateObject("PowerPoint.Application")
    Dim pre As Object
#End If
    Set pre = pptApp.Presentations.Add(msoFalse)
    Call pre.SaveAs(SavePath & SaveName)
    Debug.Print pre.Path
    Call pre.Close
       
    ‘Accessの新規作成
#If LINK_LIBRATY Then ‘参照設定あり
    Dim dbApp As Access.Application
    Set dbApp = New Access.Application
#Else ‘参照設定なし
    Dim dbApp As Object
    Set dbApp = CreateObject("Access.Application")
#End If
    Call dbApp.NewCurrentDatabase(SavePath & SaveName)
    Debug.Print dbApp.CurrentProject.Path
    Call dbApp.CloseCurrentDatabase
   
   
    GoTo FINALLY
EXCEPTION:
    MsgBox "エラー" & Err.Description
FINALLY:
    ‘オブジェクトを閉じる
    xlsApp.Quit
    docApp.Quit
    pptApp.Quit
    dbApp.Quit
    ‘フェイルセーフ（このソースコードを２次加工したとき用）
    Set xlsApp = Nothing
    Set docApp = Nothing
    Set pptApp = Nothing
    Set dbApp = Nothing
End Sub