VBAユーザー定義部品まとめ

これまでの業務や自宅で作成したVBAで、汎用的に使える部品のまとめです。

:::note info
・いずれもそこそこ動かしてるものですが、不具合etc.にお気づきの時はお知らせくださいm(_ _)m
・簡単のため、パラメータチェック等は外しています。
:::
### 1. Access専用 ###
#### 1) フォーム切り替え ####
フォーム切り替えに伴う一連の動作を共通Subにしています。
``` VB
Public Sub sPb_フォーム切り替え
    ByVal pVl_フォーム名 As String, _
    Optional ByVal pVl_フィルタ文字列 As String = "", _
    Optional ByVal pVl_最大化 As Boolean = True _
    )

    On Error GoTo ErrTrap

    Application.Echo False, "お待ちください...."
    DoCmd.Close acDefault, , acSaveNo
    If pVl_フォーム名 <> "" Then        ' フォーム名未設定時は現在のフォームを閉じるのみ
        DoCmd.OpenForm pVl_フォーム名, acNormal, , pVl_フィルタ文字列
        If pVl_最大化 Then
            Application.RunCommand acCmdDocMaximize
        End If
    End If

ErrTrap:
    Application.Echo True
    Exit Sub

End Sub
```
### 2. Access/Excel共用 ####
#### 1) 配列ソート ####
引数で参照渡しした配列の内容をクイックソートします。
``` VB
Public Sub sPb_配列ソート( _
    ByRef pRf_配列 As Variant, _
    ByVal pVl_下限値 As Long, _
    ByVal pVl_上限値 As Long _
    )

    Dim i As Long, j As Long
    i = pVl_下限値
    j = pVl_下限値

    Dim 中間値 As Variant
    中間値 = pRf_配列((pVl_下限値 + pVl_上限値) \ 2)

    Dim temp As Variant

    Do While (i <= j)
        Do While (pRf_配列(i) < 中間値 And i < pVl_上限値)
            i = i + 1
        Loop
        Do While (中間値 < pRf_配列(j) And j > pVl_下限値)
            j = j - 1
        Loop

        if (i <= j) then
            temp = pRf_配列(i)
            pRf_配列(i) = pRf_配列(j)
            pRf_配列(j) = temp
            i = i + 1
            j = j - 1
        End If
    Loop

    If (pVl_下限値 < j) Then
        Call sPb_配列ソート(pRf_配列, pVl_下限値, j)
    End If
    If (i < pVl_上限値) Then
        Call sPb_配列ソート(pRf_配列, i. pVl_上限値)
    End If

End Sub
```
#### 2) コードパーツ抽出 ####
コードを特定のセパレーターで区分けしたうち、順序番目の内容を返します。
``` VB
Public Function fPb_コードパーツ抽出( _
    ByVal pVl_コード As String, _
    ByVal pVl_セパレーター As String, _
    ByVal pVl_順序 As Integer _
    ) As String

    Dim w_パーツ As Variant
    ' ***** 区分けした内容を配列に格納⇒順序指定した内容を取り出し *****
    w_パーツ = Split(pVl_コード, pVl_セパレーター)
    If pVl_順序 > UBound(w_パーツ) + 1 Then
        fPb_コードパーツ抽出 = ""
        Exit Function
    End If

    fPb_コードパーツ抽出 = w_パーツ(pVl_順序 - 1)
    Exit Function

End Function
```
#### 3) カンマデータTab置き換え ####
CSVデータの区切りのカンマのみをTabに置き換える関数。
データ中にカンマが含まれる場合は、該当項目はダブルクォーテーションで囲まれてる前提です。
``` VB
Public Function fPb_カンマデータTab置き換え( _
    ByVal pVl_文字列 As String _
    ) As String

    Dim cnt As Long, i As Long

    cnt = 0
    For i = 1 To Len(pVl_文字列)
        Select Case Mid(pVl_文字列, i, 1)
        Case Chr(34)        ' ダブルクォーテーション
            cnt = cnt + 1
        Case ","
            If cnt Mod 2 = 0 Then
                ' データ区切りのカンマのみをTabに置き換え
                pVl_文字列 = Left(pVl_文字列, i - 1) & vbTab & Right(pVl_文字列, Len(pVl_文字列) - i)
            End If
        Case Else
        End Select
    Next i

    fPb_カンマデータTab置き換え = pVl_文字列

End Function
```
#### 4)曜日指定日取得 ####
指定した年月の第●回目の●曜日（⇒日本で最近増えた休日のパターン）の日付を返します。
``` VB
Public Function fPb_曜日指定日取得( _
    ByVal pVl_基準年 As Long, _
    ByVal pVl_基準月 As Integer, _
    ByVal pVl_指定曜日No As Integer, _
    ByVal pVl_指定週目 As Integer _
    ) As Integer

    Dim 日付ベース As Interger
    ' 指定曜日と当月初日との差分を取得⇒当月第一●曜日を求める
    日付ベース = pVl_指定曜日No - Weekday(DateSerial(pVl_基準年, pVl_基準月, 1)) + 1
    If 日付ベース <= 0 Then
        日付ベース = 日付ベース + 7
    End If

    fPb_曜日指定日取得 = 日付ベース + 7 * (pVl_指定週目 - 1)

End Function
```
#### 5) 春分の日／秋分の日算出 ####
原則、両者とも[国立天文台](https://eco.mtk.nao.ac.jp/)が定めた計算式により求めるらしいですが、かなりごくまれに例外もあり得るそうです・・・
``` VB
Public Function fPb_春分の日算出( _
    ByVal pVl_基準年 As Long _
    ) As Integer

    fPb_春分の日算出 = Int(20.8431 + 0.242194 * (pVl_基準年 - 1980) - Int(pVl_基準年 - 1980) / 4)

End Function
Public Function fPb_秋分の日算出( _
    ByVal pVl_基準年 As Long _
    ) As Integer

    fPb_秋分の日算出 = Int(23.2488 + 0.242194 * (pVl_基準年 - 1980) - Int(pVl_基準年 - 1980) / 4)

End Function
```