32

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になり、サブが再度実行されて追加されます）別のダッシュ）。これを行うためのより良い方法に関する提案はありますか？

4

9 に答える 9

64

日付を受け入れるためにテキストボックスまたは入力ボックスを使用することは決してお勧めしません。非常に多くのことがうまくいかない可能性があります。mscal.ocxまたはmscomct2.ocxを登録する必要があり、自由に配布できるファイルではないため、CalendarControlまたはDatePickerの使用を提案することすらできません。

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

長所：

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

短所：

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

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

  1. Userform1.frmおよびUserform1.frxをここからダウンロードします。
  2. VBAで、Userform1.frm下の画像に示すようにインポートするだけです。

フォームのインポート

ここに画像の説明を入力してください

それを実行する

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

Sub Sample()
    UserForm1.Show
End Sub

動作中のスクリーンショット

ここに画像の説明を入力してください

注：カレンダーを新しいレベルに引き上げるもご覧ください。

于 2012-08-17T22:24:03.287 に答える
36

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

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

3つのカレンダー例

日付ピッカーを使用するには、CalendarForm.frmファイルをVBAプロジェクトにインポートするだけです。上記の各カレンダーは、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標準をサポートします
  • ヘッダーの月または年のラベルをクリックすると、選択可能なコンボボックスが表示されます
  • 日付の上にマウスを置くと、日付の色が変わります
于 2014-09-30T02:17:40.480 に答える
11

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

'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
于 2012-08-17T19:48:24.713 に答える
7

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

それでも、自分で作成する必要があるところまで来ました。そして、私はここに投稿しています。多くの人がこの投稿にアクセスし、その恩恵を受けていると確信しているからです。

私がしたことは、一時的なワークシートを使用しないことを除いて、Sidが行うことと同じように非常に単純でした。計算は非常に単純で簡単なので、他の場所にダンプする必要はないと思いました。カレンダーの最終出力は次のとおりです。

ここに画像の説明を入力してください

設定方法：

  • 42Label個のコントロールを作成し、順番に名前を付けて、左から右、上から下に配置します（このラベルには、上から灰色25までの灰色が含まれてい5ます）。Labelコントロールの名前をLabel_01、Label_02などに変更します。42個のラベルすべてのTagプロパティをに設定しdtsます。
  • Labelヘッダー用にさらに7つのコントロールを作成します（これにはSu、Mo、Tu ...が含まれます）
  • さらに2つのコントロールを作成しますLabel。1つは水平線（高さを1に設定）用で、もう1つは月と年の表示用です。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）
ヒント：最初の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

以上です。これは生であり、あなたはそれにあなた自身のひねりを加えることができます。
私はこれをしばらく使用していますが、問題はありません（パフォーマンスと機能の面で）。
まだですが、Error Handling簡単に管理できると思います。
実際、効果がなければ、コードは短すぎます。
あなたはあなたの日付がselect_label手順のどこに行くかを管理することができます。HTH。

于 2017-07-15T05:08:02.280 に答える
2

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

このアプローチにより、ユーザーはテキストボックスに好きな形式で日付を入力し、編集が完了したら最後に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が開発したのは、はるかに優れたアプローチ、つまり本格的な日付ピッカー制御だと思います。

于 2012-08-17T23:28:24.873 に答える
2

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

ほんの数行の簡単な行

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
于 2012-09-05T18:46:16.243 に答える
2

楽しみのために、私は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
于 2012-08-17T21:22:44.217 に答える
1

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

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

  1. テキストボックスのChangeイベントの代わりに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
于 2014-06-29T02:47:01.960 に答える
1 
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

これは私のために働きます。:)

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

私はブラジル人です、そして私の英語は貧弱です、どんな間違いでも申し訳ありません。

于 2016-02-03T22:58:34.850 に答える