'***************************************************************************************************
' 条件付きコンパイルのテスト① Module1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'19/10/22(1.00)新規作成
'20/03/03(1.10)記述標準化準拠、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
' 下記の2行の内のどちらかをコメントにして下さい!
'#Const cnsTest = 0 ' ←本番
#Const cnsTest = 1 ' ←テスト
'***************************************************************************************************
' ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST1
'* 機能 :条件付きコンパイルのテスト①
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2019年10月22日
'* 作成者 :井上 治
'* 更新日 :2020年03月03日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST1()
'-----------------------------------------------------------------------------------------------
Dim strMSG As String ' メッセージWORK
#If cnsTest = 1 Then
strMSG = "これは「テスト」です!"
#Else
strMSG = "これは「本番」です!"
#End If
MsgBox strMSG
End Sub
'----------------------------------------<< End of Source >>----------------------------------------
'***************************************************************************************************
' 条件付きコンパイルを使用しない場合 Module0(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'19/10/22(1.00)新規作成
'20/03/03(1.10)記述標準化準拠、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
' 下記の2行の内のどちらかをコメントにして下さい!
'Const cnsTest = 0 ' ←本番
Const cnsTest = 1 ' ←テスト
'***************************************************************************************************
' ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST0
'* 機能 :条件付きコンパイルを使用しない場合
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2019年10月22日
'* 作成者 :井上 治
'* 更新日 :2020年03月03日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST0()
'-----------------------------------------------------------------------------------------------
Dim strMSG As String ' メッセージWORK
' テスト判定
If cnsTest = 1 Then
strMSG = "これは「テスト」です!"
Else
strMSG = "これは「本番」です!"
End If
MsgBox strMSG
End Sub
'----------------------------------------<< End of Source >>----------------------------------------
'***************************************************************************************************
' 条件付きコンパイルのテスト② Module2(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'19/10/22(1.00)新規作成
'20/03/03(1.10)記述標準化準拠、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
' 下記の2行の内のどちらかをコメントにして下さい!
'#Const cnsTest = 0 ' ←本番
#Const cnsTest = 1 ' ←テスト
' システム定数
#If cnsTest = 1 Then
Public Const g_cnsSystemTitle As String = "テストシステム"
Public Const g_cnsSystemDatabase As String = "C:\DB\TEST_DB.mdb"
Public Const g_cnsSystemUrl As String = "http://localhost/TEST/"
#Else
Public Const g_cnsSystemTitle As String = "本番システム"
Public Const g_cnsSystemDatabase As String = "\\HONBAN_SV\DB\HONBAN_DB.mdb"
Public Const g_cnsSystemUrl As String = "http://HONBAN_SV/"
#End If
'***************************************************************************************************
' 条件付きコンパイルのテスト③ Module3(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev 変更履歴内容------------------------------------------------------------------------>
'19/10/22(1.00)新規作成
'20/03/03(1.10)記述標準化準拠、他
'***************************************************************************************************
'*****************************************************************************************
' 条件付きコンパイルのテスト③ システムが持つ条件付きコンパイル定数の利用
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*****************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsTitle As String = "システムが持つ条件付きコンパイル定数"
'***************************************************************************************************
' ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST3
'* 機能 :条件付きコンパイルのテスト③ 本ワークブックを別名で保存します
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2019年10月22日
'* 作成者 :井上 治
'* 更新日 :2020年03月03日
'* 更新者 :井上 治
'* 機能説明:システムが持つ条件付きコンパイル定数の利用
'* 注意事項:
'***************************************************************************************************
Sub TEST3()
'-----------------------------------------------------------------------------------------------
#If VBA7 And Win64 Then
' 64ビット版Excelのご利用はお断わりしています(例ですが....)
MsgBox "本システムは64ビット版Excelではご利用いただけません。", , g_cnsTitle
Exit Sub
#End If
'-----------------------------------------------------------------------------------------------
Const cnsRootPath = "C:\" ' ルートフォルダ
Const cnsFixRootPath = 1 ' ルートフォルダ以外を選択不可にする時は1に
' キャンセル時に初期化する時は3に
Dim strFileName As String
' 「名前を付けて保存」ダイアログよりファイル名の取得(引数は呼び先記述を参照)
' ※2つ目以降の引数は省略が可能です。
strFileName = modFolderPicker2.SaveDialog(g_cnsTitle, _
True, _
cnsRootPath, _
cnsFixRootPath, _
CurDir, _
"保存")
' キャンセルは終了
If Len(strFileName) = 0 Then Exit Sub
'-----------------------------------------------------------------------------------------------
' 拡張子による保存先のファイル名妥当性チェック
Const cnsXLS As String = ".XLS"
Const cnsXLSX As String = ".XLSX"
Const cnsXLSM As String = ".XLSM"
Dim lngPos As Long ' 拡張子境界文字位置
Dim strExtU As String ' 拡張子(大文字)
lngPos = InStrRev(strFileName, ".")
strExtU = UCase(Mid(strFileName, lngPos))
If ((strExtU <> cnsXLS) And (strExtU <> cnsXLSX) And (strExtU <> cnsXLSM)) Then
MsgBox "このファイル名はExcelワークブック形式ではありません。", , g_cnsTitle
Exit Sub
End If
'-----------------------------------------------------------------------------------------------
' 利用Excel(Office)のバージョンによるファイル名妥当性チェック
#If VBA7 Then
' Office2010以降
If strExtU = cnsXLSX Then
MsgBox "本ワークブックは「マクロ有効ブック」で保存して下さい。", , g_cnsTitle
Exit Sub
End If
#Else
' Office2007以前(Office2007は2003と同じ扱いになってしまう)
If strExtU <> cnsXLS Then
MsgBox "Excel2003以前のバージョンでは指定の形式では保存できません。", , g_cnsTitle
Exit Sub
End If
#End If
'-----------------------------------------------------------------------------------------------
' 指定ファイル名で保存する
' ※VBA7判定により旧Verで新Verの定数がコンパイルエラーになるのを防ぐ
#If VBA7 Then
' 拡張子からの指定形式で保存
If strExtU = cnsXLS Then
ThisWorkbook.SaveAs strFileName, xlExcel8
Else
ThisWorkbook.SaveAs strFileName, xlOpenXMLWorkbookMacroEnabled
End If
#Else
' XLS形式(固定)で保存
ThisWorkbook.SaveAs strFileName, xlWorkbookNormal
#End If
End Sub
'----------------------------------------<< End of Source >>----------------------------------------