VBAのテキストボックスでMM / DD / YYYY日付をフォーマットする

Question

VBAテキストボックスの日付をMM/DD/YYYY形式に自動的にフォーマットする方法を探しています。ユーザーが入力するときにフォーマットするようにしたいと考えています。たとえば、ユーザーが2番目の番号の場合、プログラムは自動的に「/」を入力します。今、私は次のコードでこれを動作させました（2番目のダッシュと同様に）：

Private Sub txtBoxBDayHim_Change()
    If txtBoxBDayHim.TextLength = 2 or txtBoxBDayHim.TextLength = 5 then
    txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
End Sub

現在、これは入力時に非常に効果的です。ただし、削除しようとすると、まだダッシュに入っているため、ユーザーがダッシュの1つを過ぎて削除することはできません（ダッシュを削除すると、長さが2または5になり、サブが再度実行され、追加されます別のダッシュ）。これを行うためのより良い方法に関する提案はありますか？

Answer 1

テキストボックスまたは入力ボックスを使用して日付を受け入れることはお勧めしません。非常に多くのことがうまくいかないことがあります。カレンダーコントロールまたは日付ピッカーを使用することをお勧めすることもできません。mscal.ocxまたはmscomct2.ocxを登録する必要があり、それらは自由に配布可能なファイルではないため非常に苦痛です。

ここに私がお勧めするものがあります。このカスタムメイドのカレンダーを使用して、ユーザーからの日付を受け入れることができます

[〜＃〜] pros [〜＃〜]：

1. ユーザーが間違った情報を入力することを心配する必要はありません
2. ユーザーがテキストボックスに貼り付けることを心配する必要はありません。
3. 主要なコードを書くことを心配する必要はありません。
4. 魅力的なGUI
5. アプリケーションに簡単に組み込むことができます
6. Mscal.ocxやmscomct2.ocxなどのライブラリを参照する必要があるコントロールは使用しません。

[〜＃〜] cons [〜＃〜]：

うーん...うーん...何も考えられない...

使用方法（ドロップボックスにファイルがありません。カレンダーのアップグレードバージョンについては、投稿の下部を参照してください）

1. Userform1.frmおよびUserform1.frx from here 。
2. VBAで、単にUserform1.frm以下の画像に示すように。

フォームをインポートする

ITを実行中

任意の手順で呼び出すことができます。例えば

Sub Sample()
    UserForm1.Show
End Sub

アクションのスクリーンショット

[〜＃〜] note [〜＃〜]： カレンダーを新しいレベルに移動する

Answer 2

これは、Siddharth Routの答えと同じ概念です。しかし、使用するプロジェクトに合わせてルックアンドフィールを調整できるように、完全にカスタマイズできる日付ピッカーが必要でした。

このリンクをクリックできます 私が思いついたカスタム日付ピッカーをダウンロードします。以下は、実行中のフォームのスクリーンショットです。

日付ピッカーを使用するには、VBAプロジェクトにCalendarForm.frmファイルをインポートするだけです。上記の各カレンダーは、1回の関数呼び出しで取得できます。結果は、使用する引数に依存するだけであり（すべてはオプションです）、必要に応じてカスタマイズできます。

たとえば、左側の最も基本的なカレンダーは、次のコード行で取得できます。

MyDateVariable = CalendarForm.GetDate

これですべてです。そこから、必要なカレンダーを取得する引数を含めるだけです。以下の関数呼び出しにより、右側に緑のカレンダーが生成されます。

MyDateVariable = CalendarForm.GetDate( _
    SelectedDate:=Date, _
    DateFontSize:=11, _
    TodayButton:=True, _
    BackgroundColor:=RGB(242, 248, 238), _
    HeaderColor:=RGB(84, 130, 53), _
    HeaderFontColor:=RGB(255, 255, 255), _
    SubHeaderColor:=RGB(226, 239, 218), _
    SubHeaderFontColor:=RGB(55, 86, 35), _
    DateColor:=RGB(242, 248, 238), _
    DateFontColor:=RGB(55, 86, 35), _
    SaturdayFontColor:=RGB(55, 86, 35), _
    SundayFontColor:=RGB(55, 86, 35), _
    TrailingMonthFontColor:=RGB(106, 163, 67), _
    DateHoverColor:=RGB(198, 224, 180), _
    DateSelectedColor:=RGB(169, 208, 142), _
    TodayFontColor:=RGB(255, 0, 0), _
    DateSpecialEffect:=fmSpecialEffectRaised)

ここに含まれる機能のいくつかの小さな味です。すべてのオプションは、userformモジュール自体に完全に文書化されています。

• 使いやすさ。ユーザーフォームは完全に自己完結型であり、任意のVBAプロジェクトにインポートして、追加のコーディングがあれば、あまり使用することはできません。
• シンプルで魅力的なデザイン。
• 完全にカスタマイズ可能な機能、サイズ、および配色
• ユーザーの選択を特定の日付範囲に制限する
• 週の最初の曜日の任意の日を選択してください
• 週番号とISO標準のサポートを含める
• ヘッダーの月または年のラベルをクリックすると、選択可能なコンボボックスが表示されます
• 日付をマウスオーバーすると色が変わります

Answer 3

長さを追跡するために何かを追加し、ユーザーがテキストを追加するか削除するかを「チェック」できるようにします。これは現在テストされていませんが、これに似たものが機能するはずです（特にユーザーフォームがある場合）。

'add this to your userform or make it a static variable if it is not part of a userform
private oldLength as integer

Private Sub txtBoxBDayHim_Change()
    if ( oldlength > txboxbdayhim.textlength ) then
        oldlength =txtBoxBDayHim.textlength
        exit sub
    end if

    If txtBoxBDayHim.TextLength = 2 or txtBoxBDayHim.TextLength = 5 then
    txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
    end if
    oldlength =txtBoxBDayHim.textlength
End Sub

Answer 4

私も、何らかの方法で同じジレンマにつまずきました。なぜExcel VBAにDate Pickerがないのか。私たち全員のために何かを作成する素晴らしい仕事をしてくれたシドに感謝します。

それにもかかわらず、私は自分自身を作成する必要があるポイントに来ました。多くの人がこの投稿を読んで利益を得ているので、ここに投稿しています。

私がやったことは、一時的なワークシートを使用しないことを除いて、Sidのように非常に簡単でした。計算は非常にシンプルで簡単だと思ったので、どこかにダンプする必要はありません。カレンダーの最終出力は次のとおりです。

設定方法：

• 42個のLabelコントロールを作成し、順番に名前を付けて、左から右、上から下に配置します（このラベルには、灰色の25から灰色の5までが含まれます）。 Labelコントロールの名前をLabel_01、Label_02などに変更します。 42個すべてのラベルTagプロパティをdtsに設定します。
• ヘッダー用にさらに7つのLabelコントロールを作成します（これにはSu、Mo、Tu ...が含まれます）
• さらに2つのLabelコントロールを作成します。1つは水平線用（高さは1に設定）、もう1つはMonth and Year表示用です。月と年の表示に使用されるLabelに名前を付けますLabel_MthYr
• 2つのImageコントロールを挿入します。1つは前の月をスクロールするための左のアイコンを含み、もう1つは来月をスクロールするためのものです（単純な左右の矢印アイコンを好みます）。 Image_LeftおよびImage_Rightという名前を付けます

レイアウトは多かれ少なかれこのようにする必要があります（これを使用する人には創造性を任せます）。

宣言：
選択された現在の月を保持するために、最上部で宣言された1つの変数が必要です。

Option Explicit
Private curMonth As Date

プライベートプロシージャと関数：

Private Function FirstCalSun(ref_date As Date) As Date
    '/* returns the first Calendar sunday */
    FirstCalSun = DateSerial(Year(ref_date), _
                  Month(ref_date), 1) - (Weekday(ref_date) - 1)
End Function

---

Private Sub Build_Calendar(first_sunday As Date)
    '/* This builds the calendar and adds formatting to it */
    Dim lDate As MSForms.Label
    Dim i As Integer, a_date As Date

    For i = 1 To 42
        a_date = first_sunday + (i - 1)
        Set lDate = Me.Controls("Label_" & Format(i, "00"))
        lDate.Caption = Day(a_date)
        If Month(a_date) <> Month(curMonth) Then
            lDate.ForeColor = &H80000011
        Else
            If Weekday(a_date) = 1 Then
                lDate.ForeColor = &HC0&
            Else
                lDate.ForeColor = &H80000012
            End If
        End If
    Next
End Sub

---

Private Sub select_label(msForm_C As MSForms.Control)
    '/* Capture the selected date */
    Dim i As Integer, sel_date As Date
    i = Split(msForm_C.Name, "_")(1) - 1
    sel_date = FirstCalSun(curMonth) + i

    '/* Transfer the date where you want it to go */
    MsgBox sel_date

End Sub

画像イベント：

Private Sub Image_Left_Click()

    If Month(curMonth) = 1 Then
        curMonth = DateSerial(Year(curMonth) - 1, 12, 1)
    Else
        curMonth = DateSerial(Year(curMonth), Month(curMonth) - 1, 1)
    End If

    With Me
        .Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With

End Sub

---

Private Sub Image_Right_Click()

    If Month(curMonth) = 12 Then
        curMonth = DateSerial(Year(curMonth) + 1, 1, 1)
    Else
        curMonth = DateSerial(Year(curMonth), Month(curMonth) + 1, 1)
    End If

    With Me
        .Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With

End Sub

---

ユーザーがラベルをクリックしているように見えるようにこれを追加し、Image_Rightコントロールでも行う必要があります。

Private Sub Image_Left_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                                 ByVal X As Single, ByVal Y As Single)
    Me.Image_Left.BorderStyle = fmBorderStyleSingle
End Sub

Private Sub Image_Left_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Image_Left.BorderStyle = fmBorderStyleNone
End Sub

ラベルイベント：
これらすべてを42個のラベルすべてに対して行う必要があります（Label_01からLable_42）
Tip：最初の10をビルドし、残りを検索して置換するだけです。

Private Sub Label_01_Click()
    select_label Me.Label_01
End Sub

---

これは、日付にカーソルを合わせてクリック効果を得るためです。

Private Sub Label_01_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BorderStyle = fmBorderStyleSingle
End Sub

Private Sub Label_01_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BackColor = &H8000000B
End Sub

Private Sub Label_01_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                             ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BorderStyle = fmBorderStyleNone
End Sub

ユーザーフォームイベント：

Private Sub UserForm_Initialize()
    '/* This is to initialize everything */
    With Me
        curMonth = DateSerial(Year(Date), Month(Date), 1)
        .Label_MthYr = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With

End Sub

---

繰り返しますが、日付のホバリング効果のためだけです。

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)

    With Me
        Dim ctl As MSForms.Control, lb As MSForms.Label

        For Each ctl In .Controls
            If ctl.Tag = "dts" Then
                Set lb = ctl: lb.BackColor = &H80000005
            End If
        Next
    End With

End Sub

以上です。これは未加工であり、独自の工夫を加えることができます。
私はしばらくこれを使用していましたが、問題はありません（パフォーマンスと機能に関して）。
No Error Handlingはまだありますが、簡単に管理できます。
実際には、効果がなければ、コードは短すぎます。
_select_labelプロシージャで日付の行き先を管理できます。 HTH。

Answer 5

迅速な解決策として、私は通常このようにします。

このアプローチにより、ユーザーはテキストボックスに好きな形式で日付を入力し、編集が終了したら最終的にmm/dd/yyyy形式でフォーマットできます。したがって、非常に柔軟です。

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TextBox1.Text <> "" Then
        If IsDate(TextBox1.Text) Then
            TextBox1.Text = Format(TextBox1.Text, "mm/dd/yyyy")
        Else
            MsgBox "Please enter a valid date!"
            Cancel = True
        End If
    End If
End Sub

ただし、Sidが開発した方法は、はるかに優れたアプローチ、つまり本格的な日付選択コントロールであると思います。

Answer 6

楽しみのために、私はSiddharthの個別のテキストボックスの提案を取り、コンボボックスを作成しました。興味がある人は、cboDay、cboMonth、cboYearという3つのコンボボックスを持つユーザーフォームを追加し、左から右に並べてください。次に、以下のコードをユーザーフォームのコードモジュールに貼り付けます。必要なコンボボックスプロパティはUserFormInitializationで設定されているため、追加の準備は必要ありません。

難しい部分は、年または月の変更により無効になる日を変更することです。このコードは、それが発生したときに01にリセットし、cboDayを強調表示します。

私はしばらくこのようなものをコーディングしていません。いつか誰かの興味を引くことを願っています。そうでなければ楽しかったです！

Dim Initializing As Boolean

Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As MSForms.Control
Dim cbo As MSForms.ComboBox

Initializing = True
With Me
    With .cboMonth
        '        .AddItem "month"
        For i = 1 To 12
            .AddItem Format(i, "00")
        Next i
        .Tag = "DateControl"
    End With
    With .cboDay
        '        .AddItem "day"
        For i = 1 To 31
            .AddItem Format(i, "00")
        Next i
        .Tag = "DateControl"
    End With
    With .cboYear
        '        .AddItem "year"
        For i = Year(Now()) To Year(Now()) + 12
            .AddItem i
        Next i
        .Tag = "DateControl"
    End With
    DoEvents
    For Each ctl In Me.Controls
        If ctl.Tag = "DateControl" Then
            Set cbo = ctl
            With cbo
                .ListIndex = 0
                .MatchRequired = True
                .MatchEntry = fmMatchEntryComplete
                .Style = fmStyleDropDownList
            End With
        End If
    Next ctl
End With
Initializing = False
End Sub

Private Sub cboDay_Change()
If Not Initializing Then
    If Not IsValidDate Then
        ResetMonth
    End If
End If
End Sub

Private Sub cboMonth_Change()
If Not Initializing Then
    ResetDayList
    If Not IsValidDate Then
        ResetMonth
    End If
End If
End Sub

Private Sub cboYear_Change()
If Not Initializing Then
    ResetDayList
    If Not IsValidDate Then
        ResetMonth
    End If
End If
End Sub

Function IsValidDate() As Boolean
With Me
    IsValidDate = IsDate(.cboMonth & "/" & .cboDay & "/" & .cboYear)
End With
End Function
Sub ResetDayList()
Dim i As Long
Dim StartDay As String

With Me.cboDay
    StartDay = .Text
    For i = 31 To 29 Step -1
        On Error Resume Next
        .RemoveItem i - 1
        On Error GoTo 0
    Next i
    For i = 29 To 31
        If IsDate(Me.cboMonth & "/" & i & "/" & Me.cboYear) Then
            .AddItem Format(i, "0")
        End If
    Next i
    On Error Resume Next
    .Text = StartDay
    If Err.Number <> 0 Then
        .SetFocus
        .ListIndex = 0
    End If
End With
End Sub

Sub ResetMonth()
Me.cboDay.ListIndex = 0
End Sub

Answer 7

テキストボックスで定型入力を使用することもできます。マスクを##/##/####に設定すると、入力時に常にフォーマットされ、入力されたものが真の日付であるかどうかを確認する以外にコーディングを行う必要はありません。

ほんの数行の簡単な行

txtUserName.SetFocus
If IsDate(txtUserName.text) Then
    Debug.Print Format(CDate(txtUserName.text), "MM/DD/YYYY")
Else
    Debug.Print "Not a real date"
End If

Answer 8

私は以下の回答で言及されていることに同意しますが、大量のエラーチェックが含まれていない限り、これはユーザーフォームにとって非常に悪い設計であることを示唆しています...

コードに最小限の変更を加えて必要なことを実行するには、2つのアプローチがあります。

1. テキストボックスの変更イベントの代わりにKeyUp（）イベントを使用します。以下に例を示します。

   Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   
       Dim TextStr As String
       TextStr = TextBox2.Text
   
       If KeyCode <> 8 Then ' i.e. not a backspace
   
           If (Len(TextStr) = 2 Or Len(TextStr) = 5) Then
               TextStr = TextStr & "/"
           End If
   
       End If
       TextBox2.Text = TextStr
   End Sub
   

2. または、Change（）イベントを使用する必要がある場合は、次のコードを使用します。これにより、ユーザーが数字を入力し続けるように動作が変更されます。

   12072003
   

入力中の結果は

    12/07/2003

ただし、「/」文字は、DDの最初の文字、つまり07の0が入力された場合にのみ表示されます。理想的ではありませんが、依然としてバックスペースを処理します。

    Private Sub TextBox1_Change()
        Dim TextStr As String

        TextStr = TextBox1.Text

        If (Len(TextStr) = 3 And Mid(TextStr, 3, 1) <> "/") Then
            TextStr = Left(TextStr, 2) & "/" & Right(TextStr, 1)
        ElseIf (Len(TextStr) = 6 And Mid(TextStr, 6, 1) <> "/") Then
            TextStr = Left(TextStr, 5) & "/" & Right(TextStr, 1)
        End If

        TextBox1.Text = TextStr
    End Sub

Answer 9

Private Sub txtBoxBDayHim_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then 'only numbers and backspace
    If KeyAscii = 8 Then 'if backspace, ignores + "/"
    Else
        If txtBoxBDayHim.TextLength = 10 Then 'limit textbox to 10 characters
        KeyAscii = 0
        Else
            If txtBoxBDayHim.TextLength = 2 Or txtBoxBDayHim.TextLength = 5 Then 'adds / automatically
            txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
            End If
        End If
    End If
Else
KeyAscii = 0
End If
End Sub

これは私のために動作します。 :)

あなたのコードは私を大いに助けてくれました。ありがとう！

私はブラジル人で、私の英語は下手です。間違いをおかけして申し訳ありません。