Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Otradnoe_4D
1 / 2 / 0
Регистрация: 16.11.2017
Сообщений: 32
1

Авто форматирование TextBox

02.01.2019, 06:10. Просмотров 346. Ответов 9
Метки нет (Все метки)

Доброго.
Помогите реализовать.
Нужно что бы при появление UserForm в TextBox1,2,3,4 были надписи Фамилия, Имя, Отчество, Дата рождения.
--Текст серый и полупрозрачный.
--Как только нажимаешь на поле или переходишь на поле с помощью Tab текст пропадает и вводишь то, что нужно.
--Если в поле нечего не вводилось, то текст с информацией должен появиться снова.
--Так же в TextBox Фамилия, Имя, Отчество нужно сделать, так что бы первая буква автоматический становилась заглавной, а другие строчными (на случай если регистр перепутал).
--В поле дата рождения нужно, что бы текст сам подгонялся под формат дата, к примеру, если я написал 2101999 или 2 11 1999 или 02 октября 1999 а так же 02октября1999 после перехода на другое поле с помощью Tab или курсора мыши введенное значение должно стать 02.10.1999
--в случае когда в это поле было введено любое другое значение, которое ни как не связано с датой, на 5 сек. должно появиться всплывающее уведомление о том, что формат даты не верен, автоматически заполняем поле датой 11.04.1992, фокус на поле дата рождения и выделяем весь текст в поле, начиная с левого края.
--Нужно чтобы исправления, например, в поле Фамилия происходили сразу, как перешёл на другое поле с помощью Tab ли курсора мыши.
0
Вложения
Тип файла: zip Авто форматирование текста в TextBox.zip (20.3 Кб, 7 просмотров)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
02.01.2019, 06:10
Ответы с готовыми решениями:

Авто коррекция ввода даты в TextBox
Доброго Помогите реализовать. В UserForm есть TextBox в который пользователь должен ввести дату....

Настройка расположения фигурной скобки в авто форматирование QtCreator
Я вот себе подстроил табуляция для свича: switch (control) { case value: break;...

Описать базовый класс автомобиль и от него наследуются классы: грузовые авто, уборочные авто, спортивные авто
Всем привет!:) хочу спросить кто нибудь писал программы с наследованием на С++? Интересны задачи...

Авто-абзацы в textbox
Как можно реализовать авто-абзацы в тексте, который мы ввели в текст бокс? То есть: Мы вводим...

Авто заполнение textBox'ов из БД
Никто не подскажет как это делается? Нужно сделать, но в интернете информации по этому вопросу не...

9
Otradnoe_4D
1 / 2 / 0
Регистрация: 16.11.2017
Сообщений: 32
02.01.2019, 16:36  [ТС] 2
Буду благодарен любой помощи. Так же можно рассмотреть платную помощь.
0
fever brain
oh my god
1355 / 714 / 149
Регистрация: 05.01.2016
Сообщений: 2,168
Записей в блоге: 7
02.01.2019, 18:31 3
У некоторых текстовых контролов есть свойство CueBanner либо процедура может называться SetCueBanner
Что оно делает:, если текстовое поле пустое и фокус отведен, видно серый текст до момента пока не навести фокус заново
К сожалению в текстовых контролах msOffice таких свойств нет, удивительно даже хэндла нет чтобы использовать WinApi

В блоге у меня есть программа Keeper, пример использования свойства CueBanner в поле ввода поиска

http://www.cyberforum.ru/blogs/742519/blog4952.html

0
The trick
Модератор
7742 / 2759 / 770
Регистрация: 22.02.2013
Сообщений: 3,905
Записей в блоге: 77
02.01.2019, 18:47 4
Цитата Сообщение от fever brain Посмотреть сообщение
удивительно даже хэндла нет чтобы использовать WinApi
Потому что контролы не имеют окна (windowless).
0
02.01.2019, 18:47
fever brain
oh my god
1355 / 714 / 149
Регистрация: 05.01.2016
Сообщений: 2,168
Записей в блоге: 7
02.01.2019, 21:11 5
Вот я сделал чтото похожее, по поведению ничем не отличается от поля с подсказкой
форматировать дату не стал, просто запретил в 4-м поле ввод букв

Код для пустой формы (все само появится)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Option Explicit
 
Const r = 7
Public WithEvents tx As MSForms.TextBox
Dim col As New Collection
Dim ExitUserForm As Boolean
 
 
Private Sub tx_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If tx.Name = "tx4" And (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0
End Sub
 
 
Sub MainLoop()
    Static oldFocus$, newFocus$
    On Error Resume Next
    Do
        oldFocus = Me.ActiveControl.Name
        DoEvents
        newFocus = Me.ActiveControl.Name
        If oldFocus <> newFocus Or Not (newFocus Like "tx#") Then
            Call CheckCueBanner
        End If
    Loop Until ExitUserForm
    End
End Sub
 
Sub CheckCueBanner()
    Dim i&, s$
    
    On Error Resume Next
    s = Me.ActiveControl.Name
    If s Like "tx#" Then Set tx = ActiveControl
    For i = 1 To 4
        With Me.Controls("tx" & i)
            If s <> .Name And .Text = "" Then
                .Text = col(.Name)
                .ForeColor = vbButtonShadow
            ElseIf s = .Name And .ForeColor = vbButtonShadow Then
                .Text = ""
                .ForeColor = vbWindowText
            End If
        End With
    Next
End Sub
 
 
 
Private Sub UserForm_Activate()
    Call MainLoop
End Sub
 
Private Sub UserForm_Initialize()
    Dim i&
    ExitUserForm = False
    For i = 1 To 4
        With Me.Controls.Add("forms.textbox.1", "tx" & i, 1)
            .Move r, i * r * 3, r * 25
            col.Add Choose(i, "Фамилия", "Имя", "Отчество", "Дата рождения"), "tx" & i
            Debug.Print ""
            .ForeColor = 0
        End With
    Next
    
End Sub
 
Private Sub UserForm_Terminate()
    ExitUserForm = True
End Sub
0
Миниатюры
Авто форматирование TextBox  
fever brain
oh my god
1355 / 714 / 149
Регистрация: 05.01.2016
Сообщений: 2,168
Записей в блоге: 7
03.01.2019, 00:17 6
вот еще лучше, кое как хватило терпения приблизиться к решению

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
Option Explicit
 
Const r = 7
Dim WithEvents tx As MSForms.TextBox, WithEvents cb As MSForms.CommandButton
Dim col As New Collection
 
 
 
Sub MainLoop()
    Static oldFocus$, newFocus$
    On Error Resume Next
    Do
        oldFocus = Me.ActiveControl.Name
        DoEvents
        newFocus = Me.ActiveControl.Name
        If oldFocus <> newFocus Or Not (newFocus Like "tx#") Then
        
            If oldFocus = "tx4" Then
                With Controls("tx4")
                    If Not IsDate(.Text) And .Text <> "" And newFocus <> "cb" Then
                        MsgBox "Неверный формат дд.мм.гггг"
                        .SetFocus
                    End If
                End With
            End If
            Call CheckCueBanner
        End If
    Loop
    
End Sub
 
 
Private Sub cb_Click()
    Dim i&
    For i = 1 To 4
        Me.Controls("tx" & i).Text = ""
    Next
    Call CheckCueBanner
End Sub
 
Private Sub tx_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim i&, j&
    With tx
        If .Name = "tx4" Then
            i = InStrRev(.Text, ".", .SelStart + 1)
            j = InStr(.SelStart + 1 + Abs(Mid$(.Text, .SelStart + 1, 1) = "."), .Text, ".")
            If j = 0 Then j = Len(.Text) + 1
            j = j - i: .SelStart = i: .SelLength = j - 1
        End If
    End With
End Sub
 
 
Private Sub tx_Change()
    Static oldTx$, ss&, sl&, s$
    With tx
        If .Name <> "tx4" And .Text <> "" Then
            s = Left(.Text, 1)
            If s <> UCase(s) Then .Text = UCase(s) & Mid(.Text, 2)
        End If
    End With
End Sub
 
Private Sub tx_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If tx.Name = "tx4" Then
        Select Case KeyCode
        Case 188, 190
            KeyCode = 190
        Case 8, 37 To 40, 46, 48 To 57
        Case Else
            KeyCode = 0
        End Select
    End If
End Sub
 
 
 
Sub CheckCueBanner()
    Dim i&, s$
    
    On Error Resume Next
    s = Me.ActiveControl.Name
    If s Like "tx#" Then Set tx = ActiveControl
    For i = 1 To 4
        With Me.Controls("tx" & i)
            If s <> .Name And .Text = "" Then
                .Text = col(.Name)
                .ForeColor = vbButtonShadow
            ElseIf s = .Name And .ForeColor = vbButtonShadow Then
                If s = "tx4" Then
                    .Text = "01.01.1900"
                    .SelStart = 0
                    .SelLength = 2
                    
                Else
                    .Text = ""
                End If
                .ForeColor = vbWindowText
            End If
        End With
    Next
End Sub
 
 
 
 
Private Sub UserForm_Activate()
    Call MainLoop
End Sub
 
Private Sub UserForm_Initialize()
    Dim i&
    For i = 1 To 4
        With Me.Controls.Add("forms.textbox.1", "tx" & i, 1)
            .Move r, i * r * 3, r * 25
            col.Add Choose(i, "Фамилия", "Имя", "Отчество", "Дата рождения"), "tx" & i
            .ForeColor = 0
            If i = 4 Then .HideSelection = False
        End With
    Next
    Set cb = Me.Controls.Add("forms.CommandButton.1", "cb", 1): With cb
        .Move r, i * r * 3, r * 15
        .Caption = "Очистить все"
        Controls("cb").SetFocus
    End With
    
    
End Sub
 
Private Sub UserForm_Terminate()
    End
End Sub
0
Otradnoe_4D
1 / 2 / 0
Регистрация: 16.11.2017
Сообщений: 32
03.01.2019, 00:44  [ТС] 7
fever brain, Не работает. В поле дата творится что то непонятное))) Точку можно поставить только на английской раскладке))
0
fever brain
oh my god
1355 / 714 / 149
Регистрация: 05.01.2016
Сообщений: 2,168
Записей в блоге: 7
03.01.2019, 00:51 8
Цитата Сообщение от Otradnoe_4D Посмотреть сообщение
В поле дата творится что то непонятное
Да все там понятно, зачем говоришь что не работает, может сам чтото сломал ?
если интересует только точка в поле даты то исправь сам если не получится то позже постараюсь исправить ))
1
fever brain
oh my god
1355 / 714 / 149
Регистрация: 05.01.2016
Сообщений: 2,168
Записей в блоге: 7
03.01.2019, 13:04 9
Исправил.

Теперь там есть такие строки
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub tx_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    '
    'Если в поле даты нужно вводить слова Октябрь или Июнь то лучше закоментировать эти строки
    '
    If tx.Name = "tx4" Then
        Select Case ChrW(KeyAscii)
        Case ",", "б", "ю" 'при нажатии этих клавиш всегда будет точка
            KeyAscii = 46
        End Select
    End If
End Sub
В поле даты ничего не припятствует вводить что угодно. проверка будет осуществляться при потере фокуса этого поля
тоесть варианты могут быть такими: 11 апр 1994,, 11 апреля 1994,, а при уводе фокуса (или нажатие TAB) будет произведено авто-форматирование dd.mm.yyyy - 11.04.1994

Полностью код:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
Option Explicit
 
Const r = 7
Dim WithEvents tx As MSForms.TextBox, WithEvents cb As MSForms.CommandButton
Dim col As New Collection
  
Private Sub tx_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    '
    'Если в поле даты нужно вводить слова Октябрь или Июнь то лучше закоментировать эти строки
    '
    If tx.Name = "tx4" Then
        Select Case ChrW(KeyAscii)
        Case ",", "б", "ю" 'при нажатии этих клавиш всегда будет точка
            KeyAscii = 46
        End Select
    End If
End Sub
 
 
 Private Sub cb_Click()
    Dim i&, s$
    'Кнопки
    Select Case Mid$(cb.Name, 3)
    Case 1 'Удаление текстовых полей
        For i = 1 To 4
            Me.Controls("tx" & i).Text = ""
        Next
        Call CheckCueBanner
    Case 2 'Запись в буфер обмена (серые не пишутся)
        With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            For i = 1 To 4
                With Me.Controls("tx" & i)
                    s = s & IIf(.ForeColor = vbButtonShadow, "", vbLf & .Text)
                End With
            Next
            .SetText Mid$(s, 1 + Abs(Left(s, 1) = vbLf))
            .PutInClipboard
        End With
    End Select
    
End Sub
 
 
 
 
 
Sub MainLoop()
    Static oldFocus$, newFocus$
    On Error Resume Next
    Do
        'Сравнение активных контролов _
        если контр. изменился производим действия по потере фокуса _
        наподобии LostFocus - GotFocus
        oldFocus = Me.ActiveControl.Name
        DoEvents
        newFocus = Me.ActiveControl.Name
        
        If newFocus Like "tx#" Then
            Set tx = Me.ActiveControl
        ElseIf newFocus Like "cb#" Then
            Set cb = Me.ActiveControl
        End If
        
        
         If oldFocus <> newFocus Then
            With Me.Controls("tx4")
                If oldFocus = "tx4" And newFocus <> "cb1" And .Text <> "" Then
                    If IsDate(.Text) Then
                        .Text = Format(.Text, "dd.mm.yyyy")
                    Else
                        MsgBox "Неверный формат дд.мм.гггг"
                        .SetFocus
                    End If
                End If
            End With
            Call CheckCueBanner
         End If
    Loop
    
End Sub
 
 
Private Sub tx_Change()
    Static oldTx$, ss&, sl&, s$
    With tx
        If .Name <> "tx4" And .Text <> "" Then
            s = Left(.Text, 1)
            If s <> UCase(s) Then .Text = UCase(s) & Mid(.Text, 2)
        End If
    End With
End Sub
 
 
Sub CheckCueBanner()
    Dim i&, s$
    
    On Error Resume Next
    s = Me.ActiveControl.Name
    For i = 1 To 4
        With Me.Controls("tx" & i)
            If s <> .Name And .Text = "" Then
                .Text = col(.Name)
                .ForeColor = vbButtonShadow
            ElseIf s = .Name And .ForeColor = vbButtonShadow Then
                If s = "tx4" Then
                    .Text = "11.04.1992"
                    .SelStart = 0
                    .SelLength = 2
                Else
                    .Text = ""
                End If
                .ForeColor = vbWindowText
            End If
        End With
    Next
End Sub
 
Private Sub UserForm_Activate()
    Call MainLoop
End Sub
 
Private Sub UserForm_Initialize()
    Dim i&, j&
    For i = 1 To 4
        With Me.Controls.Add("forms.textbox.1", "tx" & i, 1)
            .Move r, (i - 1) * r * 3 + r, r * 25
            col.Add Choose(i, "Фамилия", "Имя", "Отчество", "Дата рождения"), "tx" & i
            If i = 4 Then .HideSelection = False
        End With
    Next
    For i = i To i + 1: j = j + 1
        With Me.Controls.Add("forms.CommandButton.1", "cb" & j, 1)
            .Move r, (i - 1) * r * 3 + (r * j) + r, r * 15, r * 3
            .Caption = Choose(j, "Очистить все", "Скопировать")
            .SetFocus
        End With
    Next
    With Me
        .Move .Left, .Top, r * 31, r * 27
    End With
    
    
    Call CheckCueBanner
End Sub
 
Private Sub UserForm_Terminate()
    End
End Sub


Добавлено через 4 минуты
Да чуть не забыл. добавленна кнопка для записи полей в буфер обмена (скопировать)

Название: 2019-01-03_190514.jpg
Просмотров: 33

Размер: 10.8 Кб
1
Otradnoe_4D
1 / 2 / 0
Регистрация: 16.11.2017
Сообщений: 32
03.01.2019, 14:22  [ТС] 10
fever brain, Ого спасибо... теперь я буду знать как в буфер обмена копировать))) Полезная функция)) Вообще многому научился благодаря ваших трудов.
0
03.01.2019, 14:22
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
03.01.2019, 14:22

Как сделать авто-скролл для TextBox?
Подскажите как сделать авто-скролл для textbox - чтобы отображались последняя выведенная инфа в...

Форматирование текста в textBox
Скажите как лучше сделать. Имеется TextBox с ограничением длины 10 символов. пользователь вводит...

Автоматическое форматирование в textBox
Здравствуйте. Мучаюсь этим вопросом уже долгое время. В textBox вводится некоторое число...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru