作成Functionのメモ
作成したFunctionをここにメモしていきます。結構、同じような事が多いので、ここにメモしておき、再利用します。ちょっとだけ作業効率化できます。
functionにしておくとエクセルシートから使えるので便利な時があります。
6.時間計算（休憩時間を引く）
'-----------------------------------------
'関数名 ：時間計算
'機能 ：入力された開始時、分～終了時、分までの時間を計算します。
' ：内部で定義した休憩時間を除算し、時間数（ｈ）または休憩時間（ｈ）を返却します。
' ：今回は"分"部分は30分単位のみ計算します。
'入力項目：intSh:開始時間の時…9,12等
' ：intSm:開始時間の分…0,30いずれか
' ：intEh:終了時間の時…17,20等
' ：intEm:終了時間の分…0,30いずれか
' ：intFlg:返却値の選択（時間数（ｈ）：1、休憩時間（ｈ）：それ以外
'-----------------------------------------
Function fnc時間計算(intSh As Integer, intSm As Integer, intEh As Integer, intEm As Integer, intFlg As Integer) As Double
Dim varQksCst, varQkeCst '---休憩開始定義 ,休憩終了定義
Dim intStm As Integer, intEtm As Integer '---開始時間（分）,終了時間（分）
Dim intQks As Integer, intQke As Integer '---休憩開始時間（分）,休憩終了時間（分）
Dim intQkm As Integer '---休憩時間（分）
'---入力を分に変換
intStm = intSh * 60 + intSm
intEtm = intEh * 60 + intEm
'---入力チェック
If intStm > intEtm Then
'---逆転なので、ゼロで返却
fnc時間計算 = 0
Exit Function
End If
'---休憩時間TBL
varQksCst = Array(1200, 1230, 1730, 1800, 2130, 2300, 2330) '---休憩時間の開始時刻を定義（30分毎）
varQkeCst = Array(1230, 1300, 1800, 1830, 2200, 2330, 2400) '---休憩時間の終了時刻を定義（30分毎）
'---休憩時間の初期化
intQkm = 0
'---休憩時間の算出
For i = 0 To UBound(varQksCst)
'---配列分の休憩時間開始終了（分）を求める
intQks = CInt(Left(varQksCst(i), 2)) * 60 + CInt(Right(varQksCst(i), 2))
intQke = CInt(Left(varQkeCst(i), 2)) * 60 + CInt(Right(varQkeCst(i), 2))
'---開始～終了の間に休憩開始～終了があれば、休憩時間を累積
If intStm <= intQks And intQke <= intEtm Then
intQkm = intQkm + intQke - intQks
End If
Next i
'---intFlgにより返却値をセット
If intFlg = 1 Then
'---時間（ｈ）
fnc時間計算 = (intEtm - intStm - intQkm) / 60
Else
'---休憩時間（ｈ）
fnc時間計算 = intQkm / 60
End If
End Function
5.和暦取得
'-----------------------------------------
'関数名 ：和暦取得
'機能 ：入力された西暦日付から和暦日付を返却する
'入力項目：西暦日付
'-----------------------------------------
Function 和暦取得(西暦日付 As Date) As String
Select Case True
Case 西暦日付 >= DateValue("2019/05/01")
和暦取得 = "新元号" & Year(西暦日付) - 2018
Case 西暦日付 >= DateValue("1989/01/08")
和暦取得 = "平成" & Year(西暦日付) - 1988
Case 西暦日付 >= DateValue("1926/12/25")
和暦取得 = "昭和" & Year(西暦日付) - 1925
Case 西暦日付 >= DateValue("1912/07/30")
和暦取得 = "大正" & Year(西暦日付) - 1911
Case Else
和暦取得 = "明治" & Year(西暦日付) - 1867
End Select
和暦取得 = 和暦取得 & "年" & Month(西暦日付) & "月" & Day(西暦日付) & "日"
End Function
4.フルパスからファイル名取得（簡易）
'-----------------------------------------
'関数名 ：フルパスからファイル名取得（簡易版）
'機能 ：フルパスから一番\￥などで区切った一番右の物を返します。
'入力項目：フルパス
'※文字列で区切っているだけ
'-----------------------------------------
Function fGetfname(strFPath As String) As String
Dim strFPathSplit
'---/とか\で区切って
strFPathSplit = Split(Replace(strFPath, "/", "\"), "\")
'---配列の最後をセット
fGetfname = strFPathSplit(UBound(strFPathSplit))
End Function
3.コンピュータ名取得
'-----------------------------------------
'関数名 ：コンピュータ名取得
'機能 ：コンピュータの名称を取得する
'入力項目：なし
'-----------------------------------------
Function コンピュータ名取得() As String
Dim NtwkObj As Object
Set NtwkObj = CreateObject("WScript.Network")
'---コンピュータ名を取得
コンピュータ名取得 = NtwkObj.ComputerName
Set NtwkObj = Nothing
End Function
2.ユーザID取得
'-----------------------------------------
'関数名 ：ユーザ名取得
'機能 ：ユーザの名称を取得する
'入力項目：なし
'-----------------------------------------
Function ユーザ名取得() As String
Dim NtwkObj As Object
Set NtwkObj = CreateObject("WScript.Network")
'---ユーザ名を取得
ユーザ名取得 = NtwkObj.UserName
Set NtwkObj = Nothing
End Function
1.月の第ｎ、ｘ曜日の日取得
'-----------------------------------------
'関数名 ：月の第ｎ、ｘ曜日の日取得
'機能 ：指定された曜日と月の何番目かを指定して日付を取得する。
'入力項目：dt…基準となる日付。その月の日付を対象とする。
' ：n…第ｎ週を指定する
' ：x…曜日を指定する
' ：1(vbSunday)日曜日
' ：2(vbMonday)月曜日
' ：3(vbTuesday)火曜日
' ：4(vbWednesday)水曜日
' ：5(vbThursday)木曜日
' ：6(vbFriday)金曜日
' ：7(vbSaturday)土曜日
'-----------------------------------------
Function 第nx曜日の日取得(dt As Date, n As Integer, x As Integer) As String
Dim wk1d As Date '---対象年月の１日計算用WK
'---入力チェック
If x < 1 Or x > 7 Then
MsgBox ("[x]の指定に誤りがあります。x=[" & x & "]")
End
End If
'---対象年月の１日を取得
wk1d = DateSerial(Year(dt), Month(dt), 1)
'---その後のパラメータで指定された曜日になるまで日を後ろにシフト
Do Until Weekday(wk1d, vbSunday) = x
'---日を後にシフト
wk1d = DateAdd("d", 1, wk1d)
Loop
'---パラメータで指定された週分後ろにシフト
第nx曜日の日取得 = DateAdd("d", 7 * (n - 1), wk1d)
End Function