Last active
June 3, 2019 00:44
-
-
Save ApuriDasuo/152d8b4d1b65b500821660f97e30211f to your computer and use it in GitHub Desktop.
【VBA】汎用関数まとめ
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Public Const DEF_START As Integer = 0 'basファイル出力用起点定数 | |
' ■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■ | |
' 【定数】定義一覧 | |
' ■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■ | |
'================================================================== | |
' 【変更禁止】Constで使用する定数 | |
'================================================================== | |
'エラー番号 | |
Public Const DEF_ERROR_DEF As Integer = 0 'デフォルトエラー | |
Public Const DEF_ERROR_NOSEARCH As Integer = 1 'エラー:階層フォルダなし | |
Public Const DEF_ERROR_NOMODES As Integer = 2 'エラー:検索モードが範囲外 | |
Public Const DEF_ERROR_NOFOLDER As Integer = 3 'エラー:指定フォルダなし | |
Public Const DEF_ERROR_NOFILE As Integer = 4 'エラー:指定ファイルなし | |
'範囲検索モード | |
Public Const DEF_MD_R As Integer = 0 '範囲検索モード:行番号 | |
Public Const DEF_MD_C As Integer = 1 '範囲検索モード:列番号 | |
Public Const DEF_MD_R_MATAGI As Integer = 2 '範囲検索モード:行番号※空白をまたぐ | |
Public Const DEF_MD_C_MATAGI As Integer = 3 '範囲検索モード:列番号※空白をまたぐ | |
'ファイル名取得モード | |
Public Const DEF_MD_NOSUB As Integer = 0 'ファイル名取得モード:サブフォルダを除く | |
Public Const DEF_MD_ALL As Integer = 1 'ファイル名取得モード:全フォルダ | |
'現在時刻取得モード | |
Public Const DEF_MD_SYOUSAI As Integer = 0 '時刻取得モード:詳細 | |
Public Const DEF_MD_KANTAN As Integer = 1 '時刻取得モード:簡単 | |
'================================================================== | |
' 【変更OK】機種依存定数 | |
'================================================================== | |
'【機種固有】エラー番号 | |
Public Const DEF_ERROR_AAA As Integer = 5 'エラー:機種固有のエラーがあれば、ここに設定 | |
Public Const DEF_ERROR_BBB As Integer = 6 'エラー:機種固有のエラーがあれば、ここに設定 | |
'■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■ | |
' 【変数】定義一覧 | |
'■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■ | |
Public str_SetValue() As String | |
'■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■ | |
' 関数定義一覧 | |
'■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■ | |
'// IsInitArray(ary() As String) As Boolean :配列定義判定 | |
'// IsSheetSonzai(wb_Book As Workbook, str_Name As String) As Boolean :シート存在判定 | |
'// GetThisBookPath() As String :ブックのファイル名までの絶対パス | |
'// GetAnalyzePath(str_GetPath As String) As String() :ファイルパスを、フォルダパスとファイル名に分解 | |
'// GetFileList(str_Path As String, i_Mode As Integer, str_Kaku As String) As String() :指定フォルダ内のファイル一覧取得 | |
'// IsSonzaiWord(str_Search As String, str_Word As String) As Boolean :文字列存在チェック | |
'// GetFolderSonzai(str_Path As String) As Boolean :フォルダ存在チェック | |
'// GetSheetUsedRange(ws_Get As Worksheet) As Range :指定シートの記入範囲を取得 | |
'// GetRangeMax(i_Mode As Integer, rng_Start As Range) As Integer :表の最大行・列を取得 | |
'// GetSearchWordRange(ws_GetSheet As Worksheet, st_word As String) As Range :文字列検索 | |
'// GetFileData_Txt(str_Pass As String) As String() :【txt系】ファイル読み込み | |
'// GetFileData_Csv(st_Pass As String) As String() :【.csv】ファイル読み込み | |
'// OutFileData(st_filename As String, st_DefPath As String, st_Kaku As String, st_outdata As String) :【.txt】ファイル出力 | |
'// GetNowTimeString(i_Mode As Integer) As String :現在時刻を文字列で取得 | |
'// GetExcelFileSheetNames(str_FilePath As String) As String() :【ADO形式】エクセルファイルのシート名一覧を取得 | |
'// OutErrorMessage(ByVal i_error As Integer, st_addword As String) :エラーメッセージ出力 ※処理を中断する | |
'■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■ | |
' 標準モジュール置き場 | |
'■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■□■ | |
'************************************************************************************************** | |
'モジュール名 :IsInitArray | |
'概要 :配列定義判定 | |
'引数 :ary() 判定する配列 | |
'戻り値 :As Boolean true:定義済み | |
'************************************************************************************************** | |
Public Function IsInitArray(ary() As String) As Boolean | |
If Sgn(ary) <> 0 Then | |
IsInitArray = True | |
Else | |
IsInitArray = False | |
End If | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :IsSheetSonzai | |
'概要 :シート存在判定 | |
'引数 :str_Kaku As String 取得する拡張子 | |
'戻り値 :As String() ファイルパス一覧 | |
'************************************************************************************************** | |
Public Function IsSheetSonzai(wb_Book As Workbook, str_Name As String) As Boolean | |
Dim ws As Worksheet, flag As Boolean | |
For Each ws In wb_Book.Worksheets | |
If ws.Name = str_Name Then flag = True | |
Next ws | |
IsSheetSonzai = flag | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetThisBookPath | |
'概要 :ブックのファイル名までの絶対パス | |
'引数 :なし | |
'戻り値 :As String ファイルパス | |
'************************************************************************************************** | |
Public Function GetThisBookPath() As String | |
GetThisBookPath = ThisWorkbook.FullName | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetAnalyzePath | |
'概要 :ファイルパスを、フォルダパスとファイル名に分解 | |
'引数 :str_GetPath As String 判定する配列 | |
'戻り値 :As String() (0):ファイル名、(1):フォルダパス | |
'************************************************************************************************** | |
Public Function GetAnalyzePath(str_GetPath As String) As String() | |
'================================================================== | |
' 変数定義 | |
'================================================================== | |
Dim str_Ret(1) As String | |
Dim str_Split() As String | |
'================================================================== | |
' 「¥」で分解してフォルダパスとファイル名に分解 | |
'================================================================== | |
'------------------------------------------------------------------ | |
' 「¥」で分解 | |
'------------------------------------------------------------------ | |
str_Split = Split(str_GetPath, "\") | |
'------------------------------------------------------------------ | |
' 各要素を分類 | |
'------------------------------------------------------------------ | |
str_Ret(0) = str_Split(UBound(str_Split)) | |
str_Ret(1) = str_Split(0) | |
For i_Cnt = 1 To UBound(str_Split) - 1 | |
str_Ret(1) = str_Ret(1) + "\" + str_Split(i_Cnt) | |
Next | |
'------------------------------------------------------------------ | |
' 戻り値設定 | |
'------------------------------------------------------------------ | |
GetAnalyzePath = str_Ret | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetFileList | |
'概要 :指定フォルダ内のファイル一覧取得 | |
'引数 :str_Path As String 取得するフォルダパス | |
'引数 :i_Mode As Integer 取得モード値 | |
'引数 :str_Kaku As String 取得する拡張子 | |
'戻り値 :As String() ファイルパス一覧 | |
'************************************************************************************************** | |
Public Function GetFileList(str_Path As String, i_Mode As Integer, str_Kaku As String) As String() | |
'================================================================== | |
' 変数定義 | |
'================================================================== | |
Set fso_Default = CreateObject("Scripting.FileSystemObject") | |
Dim i_Cnt As Integer | |
Dim i_Separate As Integer | |
Dim str_Folder As String | |
Dim str_FileName As String | |
Dim fld_All As Object | |
Dim fld_Get As Object | |
Dim str_Ret() As String | |
Dim fso As Object | |
'================================================================== | |
' 取得拡張子を設定 | |
'================================================================== | |
If str_Kaku = "" Then | |
str_Kaku = "\" & "*." & "*" | |
Else | |
str_Kaku = "\" & "*." & str_Kaku | |
End If | |
'================================================================== | |
' フォルダ構成読み込み | |
'================================================================== | |
'------------------------------------------------------------------ | |
' ベースフォルダ存在判定 | |
'------------------------------------------------------------------ | |
If GetFolderSonzai(str_Path) = False Then | |
Call OutErrorMessage(DEF_ERROR_NOFOLDER, str_Path) | |
End If | |
'------------------------------------------------------------------ | |
' フォルダ内容を取得 | |
'------------------------------------------------------------------ | |
i_Cnt = 0 | |
ReDim str_SetValue(10000, 1) | |
'------------------------------------------------------------------ | |
' サブフォルダを除く | |
'------------------------------------------------------------------ | |
If i_Mode = DEF_MD_NOSUB Then | |
str_FileName = Dir(str_Path & str_Kaku, vbNormal) | |
Do While str_FileName <> "" | |
str_SetValue(i_Cnt, 0) = str_FileName | |
i_Cnt = i_Cnt + 1 | |
str_FileName = Dir() | |
Loop | |
'------------------------------------------------------------------ | |
' サブフォルダを含む | |
'------------------------------------------------------------------ | |
Else | |
i_Cnt = GetFileList_03(str_Path, 0, str_Kaku) | |
End If | |
'================================================================== | |
' 戻り値設定 | |
'================================================================== | |
ReDim str_Ret(i_Cnt - 1, 1) | |
For i_Cnt = 0 To UBound(str_Ret, 1) | |
str_Ret(i_Cnt, 0) = str_SetValue(i_Cnt, 0) | |
str_Ret(i_Cnt, 1) = str_SetValue(i_Cnt, 1) | |
Next | |
GetFileList = str_Ret | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetFileList_03 | |
'概要 :全フォルダ取得 | |
'************************************************************************************************** | |
Function GetFileList_03(str_Path As String, i_Id As Integer, str_Kaku As String) As Integer | |
Dim str_Set As String | |
Dim f As Object | |
str_Set = Dir(str_Path & str_Kaku) | |
Do While str_Set <> "" | |
str_SetValue(i_Id, 0) = str_Set | |
str_SetValue(i_Id, 1) = str_Path & "\" & str_Set | |
i_Id = i_Id + 1 | |
str_Set = Dir() | |
Loop | |
With CreateObject("Scripting.FileSystemObject") | |
For Each f In .GetFolder(str_Path).SubFolders | |
Call GetFileList_03(f.Path, i_Id, str_Kaku) | |
Next f | |
End With | |
GetFileList_03 = i_Id | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :IsSonzaiWord | |
'概要 :文字列存在チェック | |
'引数 :str_Search As String 検索する文字列 | |
'引数 :str_Word As String 検索する文字 | |
'戻り値 :As Boolean チェック結果 | |
'************************************************************************************************** | |
Public Function IsSonzaiWord(str_Search As String, str_Word As String) As Boolean | |
If InStr(str_Search, str_Word) > 0 Then | |
IsSonzaiWord = True | |
Else | |
IsSonzaiWord = False | |
End If | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetFolderSonzai | |
'概要 :フォルダ存在チェック | |
'引数 :str_Path As String 検索するフォルダパス | |
'戻り値 :As Boolean チェック結果 | |
'************************************************************************************************** | |
Public Function GetFolderSonzai(str_Path As String) As Boolean | |
If Dir(str_Path, vbDirectory) = "" Then | |
GetFolderSonzai = False | |
Else | |
GetFolderSonzai = True | |
End If | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetSheetUsedRange | |
'概要 :指定シートの記入範囲を取得 | |
'引数 :ws_Get 範囲を取得するシート | |
'戻り値 :As range 記入範囲 | |
'************************************************************************************************** | |
Public Function GetSheetUsedRange(ws_Get As Worksheet) As Range | |
Set GetSheetUsedRange = ws_Get.UsedRange | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetRangeMax | |
'概要 :表の最大行・列を取得 | |
'引数 :str_Path As String 検索するフォルダパス | |
'戻り値 :As Boolean チェック結果 | |
'************************************************************************************************** | |
Public Function GetRangeMax(i_Mode As Integer, rng_Start As Range) As Integer | |
'================================================================== | |
' 変数定義 | |
'================================================================== | |
Dim i_Ret As Integer | |
'================================================================== | |
' モードごとに最大番号検索 | |
'================================================================== | |
'------------------------------------------------------------------ | |
' 最大行 ※跨がない | |
'------------------------------------------------------------------ | |
If i_Mode = DEF_MD_R Then | |
If rng_Start.Offset(1, 0) = "" Then | |
i_Ret = rng_Start.Row | |
Else | |
i_Ret = rng_Start.End(xlDown).Row | |
End If | |
'------------------------------------------------------------------ | |
' 最大列 ※跨がない | |
'------------------------------------------------------------------ | |
ElseIf i_Mode = DEF_MD_C Then | |
If rng_Start.Offset(0, 1) = "" Then | |
i_Ret = rng_Start.Column | |
Else | |
i_Ret = rng_Start.End(xlToRight).Column | |
End If | |
'------------------------------------------------------------------ | |
' 最大行 ※跨ぐ | |
'------------------------------------------------------------------ | |
ElseIf i_Mode = DEF_MD_R_MATAGI Then | |
If rng_Start.Offset(1, 0) = "" Then | |
i_Ret = rng_Start.Row | |
Else | |
i_Ret = Range(Cells(Rows.Count, rng_Start.Column), Cells(Rows.Count, rng_Start.Column)).End(xlUp).Row | |
End If | |
'------------------------------------------------------------------ | |
' 最大列 ※跨ぐ | |
'------------------------------------------------------------------ | |
ElseIf i_Mode = DEF_MD_C_MATAGI Then | |
If rng_Start.Offset(0, 1) = "" Then | |
i_Ret = rng_Start.Column | |
Else | |
i_Ret = Range(Cells(rng_Start.Row, Columns.Count), Cells(rng_Start.Row, Columns.Count)).End(xlToLeft).Column | |
End If | |
'------------------------------------------------------------------ | |
' 範囲外 | |
'------------------------------------------------------------------ | |
Else | |
Call OutErrorMessage(DEF_ERROR_NOMODES, Str(i_Mode)) | |
End If | |
'================================================================== | |
' 戻り値設定 | |
'================================================================== | |
GetRangeMax = i_Ret | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetSearchWordRange | |
'概要 :文字列検索 | |
'引数 :i_sheet As Integer 検索シート番号 | |
' :st_word As String 検索文字列 | |
'戻り値 :As Range 検索結果セル範囲(単一セル) | |
'************************************************************************************************** | |
Public Function GetSearchWordRange(ws_GetSheet As Worksheet, st_word As String) As Range | |
'================================================================== | |
' データ定義 | |
'================================================================== | |
Dim rg_ret As Range | |
'================================================================== | |
' 記入セル検索 | |
'================================================================== | |
'------------------------------------------------------------------ | |
' 記入データ終点位置検索 | |
'------------------------------------------------------------------ | |
Set rg_ret = ws_GetSheet.UsedRange.Find(What:=st_word, LookIn:=xlValues, LookAt:=xlWhole) | |
'------------------------------------------------------------------ | |
' 範囲検索不可判定 | |
'------------------------------------------------------------------ | |
If Not rg_ret Is Nothing Then | |
Else | |
Call OutErrorMessage(DEF_ERROR_NOSEARCH, st_word) | |
End If | |
'================================================================== | |
' 戻り値設定 | |
'================================================================== | |
Set GetSearchWordRange = rg_ret | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetFileData_Txt | |
'概要 :【txt系】ファイル読み込み | |
'引数 :st_outdata As String 出力文字列 | |
'戻り値 :なし | |
'************************************************************************************************** | |
Public Function GetFileData_Txt(str_Pass As String) As String() | |
'================================================================== | |
' データ定義 | |
'================================================================== | |
Dim i_FlFree As Integer | |
Dim i_Row As Integer | |
Dim i_YouCnt As Integer | |
Dim str_Get As String | |
Dim str_Rec As String | |
Dim str_buf As String | |
Dim str_Sepa() As String | |
Dim str_Ret() As String | |
Dim fso_GetFile As Object | |
Dim fso_GetFileTxt As Object | |
'================================================================== | |
' ファイル存在判定 | |
'================================================================== | |
If Dir(str_Pass) = "" Then | |
Call OutErrorMessage(DEF_ERROR_NOFILE, str_Pass) | |
End If | |
'================================================================== | |
' ファイル内容取得 | |
'================================================================== | |
'------------------------------------------------------------------ | |
' ファイルから変数に格納 | |
'------------------------------------------------------------------ | |
Set fso_GetFile = CreateObject("Scripting.FileSystemObject") | |
Set fso_GetFileTxt = fso_GetFile.OpenTextFile(str_Pass) | |
str_buf = fso_GetFileTxt.ReadAll | |
Set TextFile = Nothing | |
Set fso = Nothing | |
'------------------------------------------------------------------ | |
' 戻り用配列に変換 | |
'------------------------------------------------------------------ | |
str_Ret = Split(str_buf, vbCrLf) | |
'================================================================== | |
' 戻り値設定 | |
'================================================================== | |
GetFileData_Txt = str_Ret | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetFileData_Csv | |
'概要 :【.csv】ファイル読み込み | |
'引数 :st_outdata As String 出力文字列 | |
'戻り値 :なし | |
'************************************************************************************************** | |
Public Function GetFileData_Csv(st_Pass As String) As String() | |
'================================================================== | |
' データ定義 | |
'================================================================== | |
Dim i_Cnt As Integer | |
Dim i_Cnt2 As Integer | |
Dim i_ColMax As Integer | |
Dim str_Row As String | |
Dim str_Split() As String | |
Dim str_AllData_One() As String | |
Dim str_AllData_One2() As String | |
Dim str_AllData() As String | |
i_ColMax = 0 | |
'================================================================== | |
' ファイル内容取得 | |
'================================================================== | |
'------------------------------------------------------------------------------------------------------------ | |
' 1行ずつ取得 | |
'------------------------------------------------------------------------------------------------------------ | |
str_AllData_One = GetFileData_Txt(st_Pass) | |
'------------------------------------------------------------------------------------------------------------ | |
' コンマを分解して、仮変数に格納 ※横の最大値を取得 | |
'------------------------------------------------------------------------------------------------------------ | |
ReDim str_AllData_One2(UBound(str_AllData_One, 1), 10000) | |
For i_Cnt = 0 To UBound(str_AllData_One2, 1) | |
' コンマを分解 | |
str_Split = Split(str_AllData_One(i_Cnt), ",") | |
' 分解数が現在のMAXより多かったら変数更新 | |
If UBound(str_Split, 1) > i_ColMax Then | |
i_ColMax = UBound(str_Split, 1) | |
End If | |
' 分解要素を一時変数に格納 | |
For i_Cnt2 = 0 To UBound(str_Split, 1) | |
str_AllData_One2(i_Cnt, i_Cnt2) = str_Split(i_Cnt2) | |
Next | |
Next | |
'================================================================== | |
' 配列サイズをリサイズ | |
'================================================================== | |
'------------------------------------------------------------------------------------------------------------ | |
' リサイズした配列変数に移行 | |
'------------------------------------------------------------------------------------------------------------ | |
ReDim str_AllData(UBound(str_AllData_One2, 1), i_ColMax) | |
For i_Cnt = 0 To UBound(str_AllData, 1) | |
For i_Cnt2 = 0 To UBound(str_AllData, 2) | |
str_AllData(i_Cnt, i_Cnt2) = str_AllData_One2(i_Cnt, i_Cnt2) | |
Next | |
Next | |
'------------------------------------------------------------------ | |
' 戻り値設定 | |
'------------------------------------------------------------------ | |
GetFileData_Csv = str_AllData | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :OutFileData | |
'概要 :【.txt】ファイル出力 | |
'引数 :st_filename As String ファイル名 | |
'引数 :st_DefPath As String パス | |
'引数 :st_Kaku As String 拡張子 | |
'引数 :st_outdata As String 出力データ | |
'戻り値 :なし | |
'************************************************************************************************** | |
Public Sub OutFileData(st_filename As String, st_DefPath As String, st_Kaku As String, st_outdata As String) | |
'================================================================== | |
' データ定義 | |
'================================================================== | |
Dim xlAPP As Application | |
Dim st_PJName As String | |
Dim st_filepass As String | |
Dim st_foldaname As String | |
Dim i_cnt_file As Integer | |
Dim i_cnt_teigi As Integer | |
Dim i_cnt_youso As Integer | |
'================================================================== | |
' 保存先フォルダ設定 | |
'================================================================== | |
If st_DefPath = "" Then | |
st_filepass = ThisWorkbook.Path & "\" | |
Else | |
st_filepass = st_DefPath & "\" | |
End If | |
'================================================================== | |
' ファイル存在判定 | |
'================================================================== | |
st_filename = st_filepass & st_filename & "_" & GetNowTimeString(0) & "." & st_Kaku | |
If Dir(st_filename) <> "" Then | |
Kill st_filename | |
Else | |
End If | |
'================================================================== | |
' ファイル出力 | |
'================================================================== | |
Open st_filename For Output As #1 | |
Print #1, st_outdata; | |
Close #1 | |
End Sub | |
'************************************************************************************************** | |
'モジュール名 :GetExcelFileSheetNames | |
'概要 :【ADO形式】エクセルファイルのシート名一覧を取得 | |
'引数 :なし | |
'戻り値 :なし | |
'************************************************************************************************** | |
Function GetExcelFileSheetNames(str_FilePath As String) As String() | |
'================================================================== | |
' 変数定義 | |
'================================================================== | |
Const adOpenKeyset = 1 | |
Const adLockOptimistic = 3 | |
Dim objBase As Object | |
Dim objCn As Object | |
Dim objRS As Object | |
Dim sFile As String | |
Dim sSheet As String | |
Dim str_File As String | |
Dim str_List() As String | |
Dim i As Long | |
Dim i_StCnt As Integer | |
i_StCnt = 0 | |
ReDim str_List(1000) | |
str_File = GetAnalyzePath(str_FilePath)(0) | |
'================================================================== | |
' ADO形式でシート内容取得 | |
'================================================================== | |
Set objCn = CreateObject("ADODB.Connection") | |
Set objRS = CreateObject("ADODB.Recordset") | |
With objCn | |
.Provider = "Microsoft.ACE.OLEDB.12.0" | |
.Properties("Extended Properties") = "Excel 12.0" | |
.Open str_FilePath | |
End With | |
Set objRS = objCn.OpenSchema(20) | |
i = 1 | |
Do Until objRS.EOF | |
sSheet = objRS.Fields("TABLE_NAME").Value | |
If Right(sSheet, 1) = "$" Or Right(sSheet, 2) = "$'" Then | |
If Right(sSheet, 1) = "$" Then | |
sSheet = Left(sSheet, Len(sSheet) - 1) | |
End If | |
If Right(sSheet, 2) = "$'" Then | |
sSheet = Left(sSheet, Len(sSheet) - 2) | |
End If | |
If Left(sSheet, 1) = "'" Then | |
sSheet = Mid(sSheet, 2) | |
End If | |
sSheet = Replace(sSheet, "''", "'") | |
If sSheet <> DF_SheetName_Out Then | |
If sSheet <> DF_SheetName_Trg Then | |
str_List(i_StCnt) = str_File + DF_Bunkatu + sSheet | |
i_StCnt = i_StCnt + 1 | |
End If | |
End If | |
i = i + 1 | |
End If | |
objRS.MoveNext | |
Loop | |
objRS.Close | |
objCn.Close | |
Set objRS = Nothing | |
Set objCn = Nothing | |
ReDim Preserve str_List(i_StCnt - 1) | |
GetExcelFileSheetNames = str_List | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :GetNowTimeString | |
'概要 :現在時刻を文字列で取得 | |
'引数 :i_Mode As Integer 出力形式モード値(0:秒まで記入、1:日まで記入) | |
'戻り値 :As String 時刻文字列 | |
'************************************************************************************************** | |
Function GetNowTimeString(i_Mode As Integer) As String | |
'================================================================== | |
' データ定義 | |
'================================================================== | |
Dim dt_Time As Date | |
'================================================================== | |
' 日付を文字列に変換 | |
'================================================================== | |
If i_Mode = DEF_MD_SYOUSAI Then | |
GetNowTimeString = Format(Now, "mm月dd日hh時nn分ss秒") | |
Else | |
GetNowTimeString = Format(Now, "yyyymmdd") | |
End If | |
End Function | |
'************************************************************************************************** | |
'モジュール名 :OutErrorMessage | |
'概要 :エラーメッセージ出力 ※処理を中断する | |
'引数 :ByVal i_error As Integer エラー番号 | |
' :st_addword As String 追加情報 | |
'戻り値 :なし | |
'************************************************************************************************** | |
Public Sub OutErrorMessage(ByVal i_error As Integer, st_addword As String) | |
'================================================================== | |
' 画面固定OFF | |
'================================================================== | |
Application.ScreenUpdating = True | |
'================================================================== | |
' エラーメッセージ出力 | |
'================================================================== | |
Select Case i_error | |
'------------------------------------------------------------------ | |
' 変更不可 | |
'------------------------------------------------------------------ | |
Case DEF_ERROR_NOSEARCH | |
MsgBox ("◆ 検索エラー" & vbCrLf & st_addword & vbCrLf & "指定の文字列がない") | |
Case DEF_ERROR_NOMODES | |
MsgBox ("◆ 範囲検索エラー" & vbCrLf & st_addword & vbCrLf & "範囲検索モードが範囲外") | |
Case DEF_ERROR_NOFOLDER | |
MsgBox ("◆ フォルダが存在しない" & vbCrLf & "検索しようとしているフォルダが存在しません" & vbCrLf & "検索フォルダ『 " & st_addword & " 』") | |
Case DEF_ERROR_NOFILE | |
MsgBox ("◆ ファイルが存在しない" & vbCrLf & "読み込もうとしているファイルが存在しません" & vbCrLf & "読み込みパス『 " & st_addword & " 』") | |
'------------------------------------------------------------------ | |
' 変更可 | |
'------------------------------------------------------------------ | |
Case DEF_ERROR_AAA | |
MsgBox ("◆ ここに機種固有のエラー内容を記入") | |
Case DEF_ERROR_BBB | |
MsgBox ("◆ ここに機種固有のエラー内容を記入") | |
'------------------------------------------------------------------ | |
' 未定義番号のエラー | |
'------------------------------------------------------------------ | |
Case Else | |
MsgBox ("謎のエラー" & vbCrLf & st_addword) | |
End Select | |
'================================================================== | |
' 処理中断 | |
'================================================================== | |
End | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment