ちゅん@KotorinChunChunさんの作られていたものが便利そうだったので、参考にしつつ自分でも試作してみました（ただし互換性はありません）。
下の画像をダウンロードして拡張子を「*.zip」に変更後に解凍すると、サンプルのマクロ有効ワークシート（日付を操作するクラス.xlsm）が現れます。
VBEを開いて（Alt+F11）DateExtExampleを実行するとイミディエイトウィンドウに結果が表示されます。
| VERSION 1.0 CLASS | |
| BEGIN | |
| MultiUse = -1 'True | |
| END | |
| Attribute VB_Name = "DateExt" | |
| Attribute VB_GlobalNameSpace = False | |
| Attribute VB_Creatable = False | |
| Attribute VB_PredeclaredId = True | |
| Attribute VB_Exposed = True | |
| Option Explicit | |
| Private ThisDateTime As Date | |
| Property Get FmtDefault(): FmtDefault = "Long Date": End Property | |
| Property Get FmtDate(): FmtDate = "yyyy/mm/dd": End Property | |
| Property Get FmtDateWeekDay(): FmtDateWeekDay = "yyyy/mm/dd(aaa)": End Property | |
| Property Get FmtTime(): FmtTime = "hh:nn:ss": End Property | |
| Property Get FmtDateTime(): FmtDateTime = "yyyy/mm/dd hh:nn:ss": End Property | |
| Property Get FmtYYYYMMDD(): FmtYYYYMMDD = "yyyymmdd": End Property | |
| Property Get FmtGEEMMDD(): FmtGEEMMDD = "geemmdd": End Property | |
| Property Get FmtSqlYMDHMS(): FmtSqlYMDHMS = "\#yyyy-mm-dd hh:nn:ss\#": End Property | |
| Property Get FmtSqlYMD(): FmtSqlYMD = "\#yyyy-mm-dd\#": End Property | |
| Property Get StrDefault(): StrDefault = Me.Format(FmtDefault): End Property | |
| Property Get StrDate(): StrDate = Me.Format(FmtDate): End Property | |
| Property Get StrDateWeekDay(): StrDateWeekDay = Me.Format(FmtDateWeekDay): End Property | |
| Property Get StrTime(): StrTime = Me.Format(FmtTime): End Property | |
| Property Get StrDateTime(): StrDateTime = Me.Format(FmtDateTime): End Property | |
| Property Get StrYYYYMMDD(): StrYYYYMMDD = Me.Format(FmtYYYYMMDD): End Property | |
| Property Get StrGEEMMDD(): StrGEEMMDD = Me.Format(FmtGEEMMDD): End Property | |
| Property Get StrSqlYMDHMS(): StrSqlYMDHMS = Me.Format(FmtSqlYMDHMS): End Property | |
| Property Get StrSqlYMD(): StrSqlYMD = Me.Format(FmtSqlYMD): End Property | |
| Private Sub Class_Initialize() | |
| ThisDateTime = Now() | |
| End Sub | |
| Function Create(Optional NewDateTime) As DateExt | |
| If IsMissing(NewDateTime) Then NewDateTime = VBA.DateValue(Now()) | |
| Dim NewDateTimeExt As DateExt: Set NewDateTimeExt = New DateExt | |
| Call NewDateTimeExt.SetDateTime(NewDateTime) | |
| Set Create = NewDateTimeExt | |
| End Function | |
| Function Clone() As DateExt | |
| Set Clone = Create(Me) | |
| End Function | |
| Function SetDateTime(Optional NewDateTime) As DateExt | |
| If IsMissing(NewDateTime) Then NewDateTime = VBA.DateValue(Now()) | |
| ThisDateTime = CDate(NewDateTime) | |
| Set SetDateTime = Me | |
| End Function | |
| Function SetDateTimeSerial(Optional Year, Optional Month, Optional Day, Optional Hour, Optional Minute, Optional Second) As DateExt | |
| If IsMissing(Year) Then Year = Me.Year | |
| If IsMissing(Month) Then Month = Me.Month | |
| If IsMissing(Day) Then Day = Me.Day | |
| If IsMissing(Hour) Then Hour = Me.Hour | |
| If IsMissing(Minute) Then Minute = Me.Minute | |
| If IsMissing(Second) Then Second = Me.Second | |
| ThisDateTime = VBA.DateSerial(CInt(Year), CInt(Month), CInt(Day)) + VBA.TimeSerial(CInt(Hour), CInt(Minute), CInt(Second)) | |
| Set SetDateTimeSerial = Me | |
| End Function | |
| Function SetDateSerial(Year, Month, Day) As DateExt | |
| Set SetDateSerial = SetDateTime(VBA.DateSerial(CInt(Year), CInt(Month), CInt(Day))) | |
| End Function | |
| Function SetTimeSerial(Hour, Minute, Second) As DateExt | |
| Set SetTimeSerial = SetDateTime(VBA.TimeSerial(CInt(Hour), CInt(Minute), CInt(Second))) | |
| End Function | |
| Property Get Value() ' [Default Property] | |
| Attribute Value.VB_UserMemId = 0 | |
| Value = Me.DateTime | |
| End Property | |
| Property Let Value(SpecifiedValue): Me.DateTime = SpecifiedValue: End Property | |
| Property Get DateTime(): DateTime = ThisDateTime: End Property | |
| Property Let DateTime(SpecifiedDateTime): ThisDateTime = CDate(SpecifiedDateTime): End Property | |
| Property Get DateValue() As Date: DateValue = VBA.DateValue(ThisDateTime): End Property | |
| Property Get TimeValue() As Date: TimeValue = VBA.TimeValue(ThisDateTime): End Property | |
| Property Get Year() As Long: Year = VBA.Year(ThisDateTime): End Property | |
| Property Let Year(SpecifiedYear As Long): Call SetDateTimeSerial(Year:=SpecifiedYear): End Property | |
| Property Get Month() As Long: Month = VBA.Month(ThisDateTime): End Property | |
| Property Let Month(SpecifiedMonth As Long): Call SetDateTimeSerial(Month:=SpecifiedMonth): End Property | |
| Property Get Day() As Long: Day = VBA.Day(ThisDateTime): End Property | |
| Property Let Day(SpecifiedDay As Long): Call SetDateTimeSerial(Day:=SpecifiedDay): End Property | |
| Property Get Hour() As Long: Hour = VBA.Hour(ThisDateTime): End Property | |
| Property Let Hour(SpecifiedHour As Long): Call SetDateTimeSerial(Hour:=SpecifiedHour): End Property | |
| Property Get Minute() As Long: Minute = VBA.Minute(ThisDateTime): End Property | |
| Property Let Minute(SpecifiedMinute As Long): Call SetDateTimeSerial(Minute:=SpecifiedMinute): End Property | |
| Property Get Second() As Long: Second = VBA.Second(ThisDateTime): End Property | |
| Property Let Second(SpecifiedSecond As Long): Call SetDateTimeSerial(Second:=SpecifiedSecond): End Property | |
| Property Get Weekday(Optional FirstDayOfWeek As VbDayOfWeek = vbSunday) As Long | |
| Weekday = VBA.Weekday(ThisDateTime, FirstDayOfWeek) | |
| End Property | |
| Property Get WeekdayName(Optional Abbreviate As Boolean = False) | |
| WeekdayName = VBA.WeekdayName(VBA.Weekday(ThisDateTime), Abbreviate) | |
| End Property | |
| Property Get ToString(Optional SpecifiedFormat) | |
| ToString = Me.Format(SpecifiedFormat) | |
| End Property | |
| Property Get Format(Optional SpecifiedFormat) | |
| If IsMissing(SpecifiedFormat) Then SpecifiedFormat = FmtDefault | |
| Format = VBA.Format(ThisDateTime, SpecifiedFormat) | |
| End Property | |
| Property Get ShiftYear(Optional YearOffset As Long = 0, Optional AdjustDate As Boolean = True) As DateExt | |
| Set ShiftYear = ShiftMonth(12 * YearOffset, AdjustDate) | |
| End Property | |
| Property Get ShiftMonth(Optional MonthOffset As Long = 0, Optional AdjustDate As Boolean = True) As DateExt | |
| Dim NewDateTime As Date: NewDateTime = VBA.DateSerial(VBA.Year(ThisDateTime), VBA.Month(ThisDateTime) + MonthOffset, VBA.Day(ThisDateTime)) | |
| If AdjustDate Then | |
| Dim MonthEndDate As Date: MonthEndDate = VBA.DateSerial(VBA.Year(ThisDateTime), VBA.Month(ThisDateTime) + MonthOffset + 1, 0) | |
| If MonthEndDate < NewDateTime Then NewDateTime = MonthEndDate | |
| End If | |
| Set ShiftMonth = Create(NewDateTime) | |
| End Property | |
| Property Get ShiftWeek(Optional WeekOffset As Long = 0) As DateExt | |
| Set ShiftWeek = ShiftDay(7 * WeekOffset) | |
| End Property | |
| Property Get ShiftDay(Optional DayOffset As Long = 0) As DateExt | |
| Set ShiftDay = Create(DateAdd("d", DayOffset, ThisDateTime)) | |
| End Property | |
| Property Get YearBegin() As DateExt | |
| Set YearBegin = Create(VBA.DateSerial(VBA.Year(ThisDateTime), 1, 1)) | |
| End Property | |
| Property Get YearEnd() As DateExt | |
| Set YearEnd = Create(VBA.DateSerial(VBA.Year(ThisDateTime) + 1, 1, 0)) | |
| End Property | |
| Property Get FiscalYearBegin(Optional FirstMonthOfFiscalYear = 4) As DateExt | |
| Dim NewDateTime As Date: NewDateTime = VBA.DateSerial(VBA.Year(ThisDateTime), FirstMonthOfFiscalYear, 1) | |
| If ThisDateTime < NewDateTime Then NewDateTime = DateAdd("yyyy", -1, NewDateTime) | |
| Set FiscalYearBegin = Create(NewDateTime) | |
| End Property | |
| Property Get FiscalYearEnd(Optional FirstMonthOfFiscalYear = 4) As DateExt | |
| Set FiscalYearEnd = FiscalYearBegin(FirstMonthOfFiscalYear).ShiftYear(1).ShiftDay(-1) | |
| End Property | |
| Property Get MonthBegin() As DateExt | |
| Set MonthBegin = Create(VBA.DateSerial(VBA.Year(ThisDateTime), VBA.Month(ThisDateTime), 1)) | |
| End Property | |
| Property Get MonthEnd() As DateExt | |
| Set MonthEnd = Create(VBA.DateSerial(VBA.Year(ThisDateTime), VBA.Month(ThisDateTime) + 1, 0)) | |
| End Property | |
| Property Get WeekBegin(Optional FirstDayOfWeek As VbDayOfWeek = vbMonday) As DateExt | |
| Set WeekBegin = ShiftDay(1 - VBA.Weekday(ThisDateTime, FirstDayOfWeek)) | |
| End Property | |
| Property Get WeekEnd(Optional FirstDayOfWeek As VbDayOfWeek = vbMonday) As DateExt | |
| Set WeekEnd = ShiftDay(7 - VBA.Weekday(ThisDateTime, FirstDayOfWeek)) | |
| End Property | |
| Option Explicit | |
| Sub DateExtExample() | |
| Dim dt As DateExt: Set dt = DateExt.Create(Now()) | |
| Debug.Print "今 "; dt, "日付 "; dt.DateValue, "時刻 "; dt.TimeValue, "日時 "; dt.DateTime | |
| Debug.Print "※個別", dt.Year, dt.Month, dt.Day, dt.Weekday, dt.Hour, dt.Minute, dt.Second, dt.WeekdayName, dt.WeekdayName(True) | |
| Debug.Print "表示形式", dt.StrDefault, dt.StrDate, dt.StrDateTime, dt.StrYYYYMMDD, dt.StrGEEMMDD, dt.StrSqlYMD, dt.StrSqlYMDHMS | |
| Debug.Print "※任意", dt.Format("dddd, mmm d yyyy hh:mm:ss AM/PM") | |
| Debug.Print "※時分秒を0に", dt.SetDateTimeSerial(, , , 0, 0, 0).StrDateTime | |
| Debug.Print "今週(月曜はじまり)", dt.WeekBegin; " ～ "; dt.WeekEnd | |
| Debug.Print "今週(日曜はじまり)", dt.WeekBegin(vbSunday); " ～ "; dt.WeekEnd(vbSunday) | |
| Debug.Print "今月", dt.MonthBegin; " ～ "; dt.MonthEnd | |
| Debug.Print "今年", dt.YearBegin; " ～ "; dt.YearEnd | |
| Debug.Print "今年度", dt.FiscalYearBegin; " ～ "; dt.FiscalYearEnd | |
| Debug.Print "2日後", dt.ShiftDay(2) | |
| Debug.Print "1月後の月初", dt.ShiftMonth(1).MonthBegin | |
| Debug.Print "2年2ヶ月後の月末", dt.ShiftYear(2).ShiftMonth(2).MonthEnd | |
| Debug.Print "元日の年度",: With dt.YearBegin: Debug.Print .FiscalYearBegin; " ～ "; .FiscalYearEnd: End With | |
| Debug.Print "3/31の年度",: With dt.Clone().SetDateTimeSerial(Month:=3, Day:=31): Debug.Print .FiscalYearBegin; " ～ "; .FiscalYearEnd: End With | |
| Debug.Print "4/1の年度",: With dt.Clone().SetDateTimeSerial(Month:=4, Day:=1): Debug.Print .FiscalYearBegin; " ～ "; .FiscalYearEnd: End With | |
| Debug.Print "今年度(9月はじまり)", dt.FiscalYearBegin(9), dt.FiscalYearEnd(9) | |
| End Sub |