【VBA】CommonUtil

Option Explicit

'v2
'****************************************************
'共通処理
'----------------------------------------------------
'CommonUtil
'****************************************************
'StartLogging     -ロギング開始
'EndLogging       -ロギング終了
'AddLog           -ログ追加
'StartTimer       -処理時間計測開始
'EndTimer         -処理時間計測終了
'GetProcTime      -処理時間取得
'ChangeDir        -カレントディレクトリ変更
'ArrayToCol       -変換(配列→Collection)
'ColToArray       -変換(Collection→配列)
'PasteArray       -セルに張り付け(配列)
'PasteCol         -セルに張り付け(Collection)
'ShowStatusBar    -ステータスバーに文字を表示
'SleepF           -スリープ
'GetYMD           -年月日を取得
'GetTime          -時刻を取得
'GetNow           -日時を取得
'****************************************************

'共通変数
Public logging As Boolean
Public logs As Collection

'内部用
Private startTime As Variant
Private endTime As Variant
Private procTime As Variant

#If Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

'----------------------------------------------------
'■ロギング開始
'----------------------------------------------------
Public Function StartLogging()
    logging = True
    Set logs = New Collection
End Function

'----------------------------------------------------
'■ロギング終了
'----------------------------------------------------
Public Function EndLogging()
    logging = False
    Set logs = Nothing
End Function

'----------------------------------------------------
'■ログ追加
'----------------------------------------------------
'引数1:プロシージャ名
'引数2:ログの種類
'引数3:(Optional)ログの内容
'----------------------------------------------------
Public Function AddLog(aName As String, aType As String, Optional aDescription As String)
    logs.Add "[" & aType & "][" & Format(Now, "yyyy/mm/dd hh:mm:ss") & "][" & aName & "]" & Replace(aDescription, vbLf, "")
End Function

'----------------------------------------------------
'■処理時間計測開始
'----------------------------------------------------
Public Function StartTimer()
    startTime = Time
End Function

'----------------------------------------------------
'■処理時間計測終了
'----------------------------------------------------
Public Function EndTimer()
    endTime = Time
End Function

'----------------------------------------------------
'■処理時間取得
'----------------------------------------------------
'戻り値:処理時間
'----------------------------------------------------
Public Function GetProcTime() As String
    GetProcTime = "処理時間:"
    If Hour(endTime - startTime) <> 0 Then GetProcTime = GetProcTime & Hour(endTime - startTime) & "時間"
    If Minute(endTime - startTime) <> 0 Then GetProcTime = GetProcTime & Minute(endTime - startTime) & "分"
    If Second(endTime - startTime) <> 0 Then GetProcTime = GetProcTime & Second(endTime - startTime) & "秒"
End Function

'----------------------------------------------------
'■カレントディレクトリ変更
'----------------------------------------------------
'引数:変更先のパス
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function ChangeDir(aPath As String) As Boolean
On Error GoTo Err
    With CreateObject("WScript.Shell")
        .CurrentDirectory = aPath
    End With
    ChangeDir = True
    If logging Then AddLog "CommonUtil.ChangeDir", "INFO ", "パス:" & CurDir
    Exit Function
Err:
    If logging Then AddLog "CommonUtil.ChangeDir", "ERROR", "パス:" & aPath & " / エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'■変換(配列→Collection)
'----------------------------------------------------
'備考:ユーザー定義型の配列は不可
'----------------------------------------------------
'引数:変換する配列
'----------------------------------------------------
'戻り値:変換後のコレクション
'----------------------------------------------------
Public Function ArrayToCol(aArray As Variant) As Collection
    Set ArrayToCol = New Collection
    Dim v As Variant
    '配列の場合
    If IsArray(aArray) Then
        For Each v In aArray
            ArrayToCol.Add v
        Next
    '配列でない場合
    Else
        ArrayToCol.Add aArray
    End If
End Function

'----------------------------------------------------
'■変換(Collection→配列)
'----------------------------------------------------
'引数:変換するコレクション
'----------------------------------------------------
'戻り値:変換後の配列
'----------------------------------------------------
Public Function ColToArray(aCollection As Collection) As Variant
    Dim arr As Variant: ReDim arr(aCollection.Count - 1)
    Dim i As Long
    Dim v As Variant
    For Each v In aCollection
        arr(i) = v
        i = i + 1
    Next
    ColToArray = arr
End Function

'----------------------------------------------------
'■セルに張り付け(配列)
'----------------------------------------------------
'備考:ユーザー定義型の配列は不可
'----------------------------------------------------
'引数1:張り付ける配列
'引数2:張り付け開始位置
'引数3:逆指定　※(1次元の場合)Trueで横に張り付け　デフォルトは縦
'----------------------------------------------------
Public Function PasteArray(aArray As Variant, ByVal aRange As Range, Optional aIsReverse As Boolean)
On Error GoTo Err_Array2
'2次元配列の場合
    aRange.Resize(UBound(aArray, 1), UBound(aArray, 2)) = aArray
    Exit Function
'1次元配列の場合
Array1:
On Error GoTo Err_Array1
    '横に張り付け
    If aIsReverse Then
        aRange.Resize(1, UBound(aArray, 1) + 1).Value = aArray
    '縦に張り付け
    Else
        aRange.Resize(UBound(aArray, 1) + 1).Value = WorksheetFunction.Transpose(aArray)
    End If
    Exit Function
    
Err_Array2:
    '2次元でなければ1次元の処理を行う
    Resume Array1
Err_Array1:
    '1次元,2次元でない場合、セルに張り付ける
    aRange = aArray
End Function

'----------------------------------------------------
'■セルに張り付け(Collection)
'----------------------------------------------------
'引数1:張り付けるコレクション
'引数2:張り付け開始位置
'引数3:逆指定　※Trueで横に張り付け　デフォルトは縦
'----------------------------------------------------
Public Function PasteCol(aCollection As Collection, ByVal aRange As Range, Optional aIsReverse As Boolean)
    '配列に変換
    Dim tmpArray As Variant: tmpArray = ColToArray(aCollection)
    '横に張り付け
    If aIsReverse Then
        aRange.Resize(1, UBound(tmpArray, 1) + 1).Value = tmpArray
    '縦に張り付け
    Else
        aRange.Resize(UBound(tmpArray, 1) + 1).Value = WorksheetFunction.Transpose(tmpArray)
    End If
End Function

'----------------------------------------------------
'■ステータスバーに文字を表示
'----------------------------------------------------
'戻り値:(Optional)表示内容　※省略で元に戻す
'----------------------------------------------------
Public Function ShowStatusBar(Optional aText As String)
    Application.StatusBar = IIf(aText = "", False, aText)
End Function

'----------------------------------------------------
'■スリープ
'----------------------------------------------------
'引数:スリープする秒数
'----------------------------------------------------
Public Function SleepF(ByVal aTime As Long)
    aTime = aTime * 1000
    Sleep aTime
End Function

'----------------------------------------------------
'■年月日を取得
'----------------------------------------------------
'戻り値:現在年月日
'----------------------------------------------------
Public Function GetYMD() As String
    GetYMD = Format(Date, "yyyymmdd")
End Function

'----------------------------------------------------
'■時刻を取得
'----------------------------------------------------
'戻り値:現在時刻
'----------------------------------------------------
Public Function GetTime() As String
    GetTime = Format(Time, "hhmmss")
End Function

'----------------------------------------------------
'■日時を取得
'----------------------------------------------------
'戻り値:現在日時
'----------------------------------------------------
Public Function GetNow() As String
    GetNow = Format(Now, "yyyymmdd_hhmmss")
End Function