これまでの業務や自宅で作成したVBAで、汎用的に使える部品のまとめです。
・いずれもそこそこ動かしてるものですが、不具合etc.にお気づきの時はお知らせくださいm(_ _)m
・簡単のため、パラメータチェック等は外しています。
1. Access専用
1) フォーム切り替え
フォーム切り替えに伴う一連の動作を共通Subにしています。
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) 配列ソート
引数で参照渡しした配列の内容をクイックソートします。
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) コードパーツ抽出
コードを特定のセパレーターで区分けしたうち、順序番目の内容を返します。
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に置き換える関数。
データ中にカンマが含まれる場合は、該当項目はダブルクォーテーションで囲まれてる前提です。
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)曜日指定日取得
指定した年月の第●回目の●曜日（⇒日本で最近増えた休日のパターン）の日付を返します。
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) 春分の日／秋分の日算出
原則、両者とも国立天文台が定めた計算式により求めるらしいですが、かなりごくまれに例外もあり得るそうです・・・
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