' [140.xls]



' [Module1] のコード
'★★☆　指定された条件で加減した日付を計算する　☆★★

Option Explicit

Sub start()

    UserForm1.Show

End Sub


' [UserForm1] のコード
Option Explicit

Dim 日付 As Date
Dim 結果日 As Date

Private Sub OptionButton1_Click()
計算
End Sub

Private Sub OptionButton2_Click()
計算
End Sub

Private Sub OptionButton3_Click()
計算
End Sub

Private Sub OptionButton4_Click()
計算
End Sub

Private Sub OptionButton5_Click()
計算
End Sub

Private Sub TextBox1_Change()

    '入力された値が数値として評価出来るか？を判断
    '数値として評価出来ないときは入力文字を消す
    If IsNumeric(TextBox1.Value) = False Then
        TextBox1.Value = ""
    End If

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

'Windows ExcelVBAで和暦に変換認識できる日付範囲は1868年10月13日以降のようです
    
    '入力文字を数値に変換して、認識範囲にあるか？を判断
    '範囲外の場合入力文字を消してカーソルをTextBox1から出さない
    'この時点でフォームを終了するとSetFocusでエラーになります
    'そのメッセージを On Error Resume Next で避けています
    If Val(TextBox1.Value) < 1869 Then
        TextBox1.Value = ""
        
    'この時点でフォームを閉じようとするとエラーが発生します
    'それを回避するために"On Error Resume Next"を入れる
    On Error Resume Next
        TextBox1.SetFocus
        Cancel = True
    On Error GoTo 0
        Exit Sub
    End If
    計算
    
End Sub

Private Sub TextBox2_Change()

    '入力された値が数値として評価出来るか？を判断
    '数値として評価出来ないときは入力文字を消す
    If IsNumeric(TextBox2.Value) = False Then
        TextBox2.Value = ""
    End If

End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    '月の入力時に12より大きな数字を受け付けないようにしています
    If Val(TextBox2.Value) > 12 Then
        TextBox2.Value = ""
    On Error Resume Next
        TextBox2.SetFocus
        Cancel = True
    On Error GoTo 0
        Exit Sub
    End If
    計算

End Sub

Private Sub TextBox3_Change()

    '入力された値が数値として評価出来るか？を判断
    '数値として評価出来ないときは入力文字を消す
    If IsNumeric(TextBox3.Value) = False Then
        TextBox3.Value = ""
    End If

End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
    '日付の入力時に、すでに入力済みの年と月を組み合わせて日付として評価できるか？を判断
    If IsDate(TextBox1.Value & "/" & TextBox2.Value & "/" & TextBox3.Value) = False Then
        TextBox3.Value = ""
    
    'この時点でフォームを閉じようとするとエラーが発生します
    'それを回避するために"On Error Resume Next"を入れる
    On Error Resume Next
        TextBox3.SetFocus
        Cancel = True
    On Error GoTo 0
        Exit Sub
    End If
    計算
    
End Sub

Private Sub UserForm_Initialize()

    'フォーム起動時に今日の日付をセット
    日付 = Date
    TextBox1.Value = Format(Date, "yyyy")
    TextBox2.Value = Format(Date, "m")
    TextBox3.Value = Format(Date, "d")
    
    '今日の日付を元に最初の計算を開始します
    計算
    
End Sub

Sub 計算()
Dim 前後 As String
Dim 条件名 As String
Dim 条件 As Integer
Dim i As Integer

    日付 = TextBox1.Value & "/" & TextBox2.Value & "/" & TextBox3.Value
    
    Label1.Caption = Format(日付, "yyyy/mm/dd")
    Label2.Caption = Format(日付, "ggge年mm月dd日")
    Label3.Caption = Format(日付, "aaaa")
    条件 = Val(TextBox4.Value)
    
    '各種オプションボタンのどのボタンが選択されているか判断して
    '選択された方法で計算しています
    '実際に計算に使われている関数は"DateAdd関数"です
        For i = 1 To 3
            If Me("OptionButton" & i).Value = True Then
                条件名 = Me("OptionButton" & i).Caption
            End If
        Next i
    If OptionButton4.Value = True Then
        前後 = "後"
        If OptionButton1.Value = True Then
            結果日 = DateAdd("d", 条件, 日付)
        ElseIf OptionButton2.Value = True Then
            結果日 = DateAdd("ww", 条件, 日付)
        Else
            結果日 = DateAdd("m", 条件, 日付)
        End If
    Else
        前後 = "前"
        If OptionButton1.Value = True Then
            結果日 = DateAdd("d", -条件, 日付)
        ElseIf OptionButton2.Value = True Then
            結果日 = DateAdd("ww", -条件, 日付)
        Else
            結果日 = DateAdd("m", -条件, 日付)
        End If
    End If

    '計算結果を各ラベルに表示していきます
    Label4.Caption = Format(結果日, "yyyy/mm/dd")
    Label5.Caption = Format(結果日, "ggge年mm月dd日")
    Label6.Caption = Format(結果日, "aaaa")
    Label7.Caption = Label1.Caption & "から" & 条件 & 条件名 & 前後

End Sub