Авто коррекция ввода даты в TextBox

@Otradnoe_4D · Регистрация: 16.11.2017

Author24 — интернет-сервис помощи студентам

Доброго
Помогите реализовать.
В UserForm есть TextBox в который пользователь должен ввести дату.
Идея заключается в том, когда человек ввел число, например 12 то сразу автоматом ставится точка, потом он вводит 10 и так же подставляется точка, дальше может быть два развития события либо человек написал 2019 и его курсор автоматический переводится на следующий TextBox или он просто пишет 19 и перейдя на следующий TextBox либо с помощью Tab или курсором 12.10.19 переделывается в 12.10.2019. Так же нужно что бы можно было писать только цифры и подчеркивание "_".

Так же разместил такой вопрос тут но ответ не получил((

@Святой НякаЛайк · 07.02.2019, 14:09

Самое примитивное - у вашего текстбокса пропишите такой код

Visual Basic

Private Sub TextBox1_Change()
   Dim l&
   l = Len(TextBox1)
   Select Case l
   Case 2
      TextBox1.Text = TextBox1.Text & "."
   Case 5
      TextBox1.Text = TextBox1.Text & "."
   End Select
End Sub

@Otradnoe_4D · 07.02.2019, 14:15 **[ТС]**

Примитивной это для меня))
А что насчет того что бы запретить в вод букв и оставить только ввод цирк и знака "_"?

Добавлено через 55 секунд
Я находил решения про ограничения ввода но когда пишешь букву программа выдает ош и бац а мн еп нужно что бы просто ничего не происходило

@Святой НякаЛайк · 07.02.2019, 15:11

Visual Basic

Option Explicit
 
Private Sub TextBox1_Change()
   Select Case Len(TextBox1)
   Case 2
      TextBox1.Text = TextBox1.Text & "."
   Case 5
      TextBox1.Text = TextBox1.Text & "."
   Case 10
      Application.SendKeys "{tab}"
   End Select
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If KeyAscii < 48 Or KeyAscii > 57 And KeyAscii <> 95 Then KeyAscii = 0
End Sub

Вот, добавил в код проверку нажатой клавиши. Если пытаешься вписать букву/иной недопустимый символ, то просто "ничего не происходит"

@fever brain · 07.02.2019, 15:21

Сообщение от Otradnoe_4D

Я находил решения про ограничения ввода но когда пишешь букву программа выдает ош и бац а мн еп нужно что бы просто ничего не происходило

Visual Basic

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case ChrW$(KeyAscii)
    Case 0 To 9
    Case "б", "ю", ".", ","
        KeyAscii = Asc(".")
    Case Else: KeyAscii = 0
    End Select
End Sub

@Otradnoe_4D · 07.02.2019, 18:24 **[ТС]**

Возникает проблема когда нужно подкорректировать дату. Точки удалить не получается)))

@fever brain · 07.02.2019, 20:30

Ну значит не судьба. у меня работает передвижение курсора, удаление Backspace и Del
не знаю почему ты не можешь точки удалить, наверное у тебя пиратка стоит ))

@Святой НякаЛайк · 07.02.2019, 20:35

Сообщение от Otradnoe_4D

Точки удалить не получается)))

Вот так, значит, стараешься пишешь человеку программу, которая точки ставит, а он потом эти точки мечтает удалить

Если нужно поле, идеально подходящее для работы с датой или временем, то текстбокс уступает специальному контролу "DTPicker"

@Otradnoe_4D · 07.02.2019, 20:38 **[ТС]**

Visual Basic

Option Explicit
 
Private Sub TextBox1_Change()
   Select Case Len(TextBox1)
   Case 2
      TextBox1.Text = TextBox1.Text & "."
   Case 5
      TextBox1.Text = TextBox1.Text & "."
   Case 10
      Application.SendKeys "{tab}"
   End Select
End Sub

Это работает хорошо?

Добавлено через 2 минуты
Святой НякаЛайк, Спасибо попробую)))

@Святой НякаЛайк · 07.02.2019, 21:02

Сообщение от Otradnoe_4D

Это работает хорошо?

Изначально писал - решение примитивное. Пока пишешь просто что-то типа "123456789" оно само разбивает результ на "12.34.5678" и табом перекидывает фокус в другой элемент.
А вкупе с "Private Sub TextBox1_KeyPress......." код ещё и буквы/символы отсеет.
Юзай, тестируй!

@Otradnoe_4D · 08.02.2019, 01:30 **[ТС]**

Решил проблему с точками таким образом)))

Visual Basic

Sub Дата()
   Select Case Len(TextBox1)
   Case 2
      TextBox1.Text = TextBox1.Text & "."
   Case 5
      TextBox1.Text = TextBox1.Text & "."
   Case 10
    UserForm1.TextBox2.SetFocus
   End Select
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If KeyAscii < 48 Or KeyAscii > 57 And KeyAscii <> 95 Then KeyAscii = 0
    If KeyAscii = 8 Then
    KeyAscii = 8
    Else
    Дата
    End If
End Sub

Добавлено через 1 минуту
Application.SendKeys "{tab}" - не работает почему то у меня
SendKeys - на этом момента ошибку дает
поэтому написал - UserForm1.TextBox2.SetFocus

Добавлено через 9 минут

Сообщение от Святой НякаЛайк

Если нужно поле, идеально подходящее для работы с датой или временем, то текстбокс уступает специальному контролу "DTPicker"

Такой функции у меня нет а Microsoft Access я устанавливать не хочу.

Осталось решить момент с годом в конце... что бы если пишешь 19 и переходишь на новый Box то автоматический переделает 2019 и так далее.

Заодно подскажите как сделать так что бы появлялась текущая дата при открытии UserForm)))

Добавлено через 21 минуту
Вот он рабочий результат))) Всем спасибо за помощь))) Возможно есть у кого предложения по оптимизации)) Я только учусь печатать на VBA и вообще программированию... может что то можно укоротить или на оборот дописать))

Visual Basic

Option Explicit
Sub Дата()
   Select Case Len(TextBox1)
   Case 2
      TextBox1.Text = TextBox1.Text & "."
   Case 5
      TextBox1.Text = TextBox1.Text & "."
   Case 10
    UserForm1.TextBox2.SetFocus
   End Select
End Sub
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1.Text = Format(CDate(TextBox1.Text), "DD.MM.YYYY")
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyTab Then
    TextBox1.Text = Format(CDate(TextBox1.Text), "DD.MM.YYYY")
    End If
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If KeyAscii < 48 Or KeyAscii > 57 And KeyAscii <> 95 Then KeyAscii = 0
   If KeyAscii = 8 Then
        KeyAscii = 8
   Else
        Дата
   End If
End Sub

Добавлено через 49 минут
Не получается исправить сообщение((( так что так обновленный код добавлю

Visual Basic

Option Explicit
Sub Дата()
   Select Case Len(TextBox1)
   Case 2
      TextBox1.Text = TextBox1.Text & "."
   Case 5
      TextBox1.Text = TextBox1.Text & "."
    Case 10
    UserForm1.TextBox2.SetFocus
    TextBox2.SelLength = 0
    TextBox2.SelStart = 0
   End Select
End Sub
Private Sub TextBox1_Change()
    Select Case Len(TextBox1)
        Case 10
    UserForm1.TextBox2.SetFocus
    TextBox2.SelLength = 0
    TextBox2.SelStart = 0
    End Select
End Sub
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TextBox1.Text > "" Then
    TextBox1.Text = Format(CDate(TextBox1.Text), "DD.MM.YYYY")
    End If
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyTab And TextBox1.Text > "" Then
    TextBox1.Text = Format(CDate(TextBox1.Text), "DD.MM.YYYY")
    End If
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If KeyAscii < 48 Or KeyAscii > 57 And KeyAscii <> 95 Then KeyAscii = 0
   If KeyAscii = 8 Then
        KeyAscii = 8
   Else
        Дата
   End If
End Sub

@Святой НякаЛайк · 08.02.2019, 09:13

Сообщение от Otradnoe_4D

Такой функции у меня нет а Microsoft Access я устанавливать не хочу.

При работе с формой жмём левой мышекнопкой по панельке с контролами, выбираем в появившемся меню пункт "Additional Controls"
Появляется окошко с выбором используемых контролов, в списке ищем Microsoft Date and time Picker Control
После чего в тулбоксе должон появиться DTPicker!

Предложение по оптимизации есть: вместо if KeyAscii= then KeyAscii= 8 пишем if KeyAscii<> 8 then...

Visual Basic

Option Explicit
Sub Дата()
   Select Case Len(TextBox1)
   Case 2
      TextBox1.Text = TextBox1.Text & "."
   Case 5
      TextBox1.Text = TextBox1.Text & "."
   Case 10
      UserForm1.TextBox2.SetFocus
      TextBox2.SelLength = 0
      TextBox2.SelStart = 0
   End Select
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   Debug.Print KeyAscii
   If KeyAscii < 48 Or KeyAscii > 57 And KeyAscii <> 95 Then KeyAscii = 0
   If KeyAscii <> 8 Then Дата
End Sub
 
Private Sub UserForm_Initialize()   ' При Инициализации формы в текстбокс будет выставлена текущая дата
   TextBox1 = Format(Now(), "DD.MM.YYYY")
End Sub

@Святой НякаЛайк · 08.02.2019, 09:16

Сообщение от Otradnoe_4D

текущая дата при открытии UserForm)))

Но в коде выше текущая дата будет прописываться в текстбокс при инициализации формы. Если же нужно, чтобы при каждом повторном открытии, то надо писать в событие Activate

Visual Basic

1
2
3

Private Sub UserForm_Activate()
   TextBox1 = Format(Now(), "DD.MM.YYYY")
End Sub

@Otradnoe_4D · 08.02.2019, 22:29 **[ТС]**

а как заставить работать KeyAscii в TextBox1_Change?
хочу еще подсократить.... что бы не было функции дата...

Visual Basic

Private Sub TextBox1_Change()
If KeyAscii <> 8 Then
    Select Case Len(TextBox1)
   Case 2
      TextBox1.Text = TextBox1.Text & "."
   Case 5
      TextBox1.Text = TextBox1.Text & "."
    Case 10
    UserForm1.TextBox2.SetFocus
    TextBox2.SelLength = 0
    TextBox2.SelStart = 0
   End Select
   End If
End Sub
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TextBox1.Text > "" Then TextBox1.Text = Format(CDate(TextBox1.Text), "DD.MM.YYYY")
    If TextBox1.Text = "" Then TextBox1 = Format(Now(), "DD.MM.YYYY")
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyTab And TextBox1.Text > "" Then
    TextBox1.Text = Format(CDate(TextBox1.Text), "DD.MM.YYYY")
    End If
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If KeyAscii < 48 Or KeyAscii > 57 And KeyAscii <> 95 Then KeyAscii = 0
End Sub

Хочу прейти к такому результату но программа ругается вот тут

Visual Basic

1 2	Private Sub TextBox1_Change() If KeyAscii <> 8 Then

Добавлено через 34 минуты
Святой НякаЛайк,
У меня еще вопрос... а для чего это?

Сообщение от Святой НякаЛайк

Debug.Print KeyAscii

@Святой НякаЛайк · 09.02.2019, 00:23

Сообщение от Otradnoe_4D

У меня еще вопрос... а для чего это?

Не по теме:

:D
Это магия!

Это Immediate window

Подробнее
Ещё

Добавлено через 43 минуты

Сообщение от Otradnoe_4D

но программа ругается вот тут

Самое время обратить внимание на те штуки, которые всегда на самом виду:

Visual Basic

1	Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

Здесь, в коде события KeyPress есть скобки. В них содержатся Агрументы, получаемые процедурой при данном событии.
Поэтому эта процедура может использовать KeyAscii - потому что она получила её в качестве агрумента!

А здесь:

Visual Basic

1	Private Sub TextBox1_Change()

Никаких аргументов нет, в том числе KeyAscii. Потому и не удаётся использовать.
В данном случае достаточно перетащить строки кода Change в код процедуры KeyPress, примерно так:

Visual Basic

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TextBox1 > "" Then TextBox1 = Format(CDate(TextBox1), "DD.MM.YYYY")
    If TextBox1 = "" Then TextBox1 = Format(Now(), "DD.MM.YYYY")
End Sub
 
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyTab And TextBox1 > "" Then
    TextBox1 = Format(CDate(TextBox1), "DD.MM.YYYY")
    End If
End Sub
 
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If KeyAscii < 48 Or KeyAscii > 57 And KeyAscii <> 95 Then KeyAscii = 0
   If KeyAscii <> 8 Then
    Select Case Len(TextBox1)
   Case 2
      TextBox1 = TextBox1 & "."
   Case 5
      TextBox1 = TextBox1 & "."
    Case 10
    TextBox2.SetFocus
    TextBox2.SelLength = 0
    TextBox2.SelStart = 0
   End Select
   End If
End Sub

@fever brain · 09.02.2019, 18:16

Просто надо было объяснить человеку
что любое нажатие клавиши можно контролировать
либо пропустить. либо нет, более того контролировать всю запись... тоесть немаловажно когда он ее введет, минуя все служебные припоны на это есть перепроверка даты
Как это организовать ? догадайтесь...

Добавлено через 11 минут
Otradnoe_4D, это как раз тот случай, когда требуется решить сиюминутную проблему не вникая в корни этой проблемы.

а чего напрягаться. нужно только спросить на киберфоруме у здешних старцев. Как , куда, чего и с чем.
Давайте уже начнем мозгами думать...

@Otradnoe_4D Буду мудрее сегодня 1 / 2 / 0 Регистрация: 16.11.2017 Сообщений: 43
		1
	Авто коррекция ввода даты в TextBox 07.02.2019, 13:58. Показов 15389. Ответов 15 Метки нет (Все метки) Доброго Помогите реализовать. В UserForm есть TextBox в который пользователь должен ввести дату. Идея заключается в том, когда человек ввел число, например 12 то сразу автоматом ставится точка, потом он вводит 10 и так же подставляется точка, дальше может быть два развития события либо человек написал 2019 и его курсор автоматический переводится на следующий TextBox или он просто пишет 19 и перейдя на следующий TextBox либо с помощью Tab или курсором 12.10.19 переделывается в 12.10.2019. Так же нужно что бы можно было писать только цифры и подчеркивание "_". Так же разместил такой вопрос тут но ответ не получил(( 0

@Otradnoe_4D Буду мудрее сегодня 1 / 2 / 0 Регистрация: 16.11.2017 Сообщений: 43
	07.02.2019, 14:15 [ТС]	3
	Примитивной это для меня)) А что насчет того что бы запретить в вод букв и оставить только ввод цирк и знака "_"? Добавлено через 55 секунд Я находил решения про ограничения ввода но когда пишешь букву программа выдает ош и бац а мн еп нужно что бы просто ничего не происходило 0

@Otradnoe_4D Буду мудрее сегодня 1 / 2 / 0 Регистрация: 16.11.2017 Сообщений: 43
	07.02.2019, 18:24 [ТС]	6
	Возникает проблема когда нужно подкорректировать дату. Точки удалить не получается))) 0

@fever brain oh my god 1454 / 793 / 161 Регистрация: 05.01.2016 Сообщений: 2,307 Записей в блоге: 8
	07.02.2019, 20:30	7
	Ну значит не судьба. у меня работает передвижение курсора, удаление Backspace и Del не знаю почему ты не можешь точки удалить, наверное у тебя пиратка стоит )) 0

@Святой НякаЛайк 655 / 247 / 89 Регистрация: 28.10.2015 Сообщений: 524
	07.02.2019, 21:02	10
	Сообщение от Otradnoe_4D Это работает хорошо? Изначально писал - решение примитивное. Пока пишешь просто что-то типа "123456789" оно само разбивает результ на "12.34.5678" и табом перекидывает фокус в другой элемент. А вкупе с "Private Sub TextBox1_KeyPress......." код ещё и буквы/символы отсеет. Юзай, тестируй! 0

@fever brain oh my god 1454 / 793 / 161 Регистрация: 05.01.2016 Сообщений: 2,307 Записей в блоге: 8
	09.02.2019, 18:16	16
	Просто надо было объяснить человеку что любое нажатие клавиши можно контролировать либо пропустить. либо нет, более того контролировать всю запись... тоесть немаловажно когда он ее введет, минуя все служебные припоны на это есть перепроверка даты Как это организовать ? догадайтесь... Добавлено через 11 минут Otradnoe_4D, это как раз тот случай, когда требуется решить сиюминутную проблему не вникая в корни этой проблемы. а чего напрягаться. нужно только спросить на киберфоруме у здешних старцев. Как , куда, чего и с чем. Давайте уже начнем мозгами думать... 1