Ввод десятичных дробей в поля textbox формы

[NikolayGVB]

Здравствуйте, дорогие Коллеги,

нужен Ваш совет... Требуется добавлять 2 знака после запятой для всех целых чисел, вводимых в textbox (или же добавлять лишний ноль для дробных чисел, преобразуя их в ЛЮБОМ случае в "сотые").

Ограничил набор вводимых символов в textbox только числами и запятой (событие Change), но не знаю, как преобразовывать вводимые данные, если ленивый пользователь ввел только целое число

С помощью функции Round реализовать желаемое не смог...

Заранее спасибо за помощь,
с уважением,
Николай

[viter.alex]

Функция Format. Если нужно до сотых, то подойдет параметр этой функции Currency

[NikolayGVB]

Спасибо за ответ. Одно "но" - я, к сожалению, не очень пока опытен в VB/VBA. Поэтому мои методы реализации вызывают ошибку "Type mismatch".

Private Sub txtProductPrice_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If KeyAscii < 44 Or KeyAscii > 57 Or KeyAscii = 45 Or KeyAscii = 46 _
    Or KeyAscii = 47 Then
    KeyAscii = 0
    End If
End Sub

Код события Change, в свою очередь, активирует/деактивирует следующие по порядку окна. Каким образом и где применить функцию Format? Буду очень благодарен за более подробный ответ!

С уважением,
Николай

[Sasha_Smirnov]

Пока рубль не деноминирован, дробная часть вводимой цены чаще всего нулевая, и заставлять пользователя каждый раз вводить эти пустопорожние копейки (когда их нет), думаю, не гуманно. Ну а если надо — пусть вводит. К сожалению, с обработкой ввода в поля форм давно не сталкивался, и вот написал две «демонстрашки» с функцией Format. Они запускаются по альт-R и альт-шифт-R соответственно.
Подробности о функциях смотрите по F1 (в Excel, возможно, Ctrl-F1), установив курсор на имя функции в редакторе VBA.

Sub KeenRoubles()
'предлагает ввести цену: (InputBox(
'заменяяет в ней запятую (если есть) на точку: (Replace(
'игнорирует завершающие нечисловые символы: (Val(
'округляет введённое число до сотых: Format(<...>, "0.00")

price_put = Format(Val(Replace(InputBox("Введите цену.", "ВВОД ЦЕНЫ"), ",", ".")), "0.00")

MsgBox "Введённый Вами ответ преобразовался, после округления, в " & price_put

End Sub


Sub FriendlyChat() 'то же самое плюс диалог подтверждения'

price_put = Format(Val(Replace(InputBox("Введите цену.", "ВВОД ЦЕНЫ"), ",", ".")), "0.00")

Do
    true_price = Format(InputBox("OK: цена действительно такова." & vbCr & _
    "Cancel: отмена нижеуказанного значения цены.", "ПОДТВЕРЖДЕНИЕ ЦЕНЫ", price_put), "currency")
Loop Until true_price <> vbCancel Or true_price = Null

MsgBox "Возвращаемое значение цены: " & true_price                  'отладочные'
MsgBox "Тип полученного значения: " & TypeName(true_price)  'сообщения'

End Sub

Ну ещё посмотрите (ниже) код формы ввода цен (запускаемый по альт-шифт-S в приложенном доке).
Полтора часа мучил Word, но продумать все капризы «вводящего» юзера не получилось.

[EducatedFool]

Данный код позволяет вводить в поле только цифры и одну запятую, причём после запятой допускается ввод не более 2 цифр.
При нажатии Enter введённое число преобразуется к нужному формату.

Private Sub txtProductPrice_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    txt = Me.txtProductPrice ' читаем текст из поля (для недопущения ввода двух и более запятых)
    Select Case KeyAscii
        Case 13: Me.txtProductPrice = FormatNumber(txt, 2) ' нажат Enter
        Case 8: ' нажат Backspace - ничего не делаем
        ' если запятая уже есть - отменяем ввод символа ' заменяем при вводе точку на запятую
        Case 44, 46: KeyAscii = IIf(InStr(1, txt, ",") > 0, 0, 44)
        Case 48 To 57: KeyAscii = IIf(InStr(1, txt, ",") > 0 And Len(txt) - InStrRev(txt, ",") > 1, 0, KeyAscii) 'если введена цифра
        Case Else:   KeyAscii = 0 ' иначе отменяем ввод символа
    End Select
End Sub

[Sasha_Smirnov]

Option Explicit
Dim TruePrice
Const DecDelimiter = "," 'десятичный разделитель'

Sub EscapeButton_Click(): FormaVvodaTzen.Hide: Unload Me: End Sub

Sub SwitchToKeyboard_Click()
With Copecks
    .Enabled = Not .Enabled
    If .Enabled Then
    SwitchToKeyboard.Caption = "Режим: ввод целых рублей и дробной части."
    Else
    SwitchToKeyboard.Caption = "Режим: ввод только целых рублей."
    End If
End With
End Sub

Sub Vvod_Rubly_Click(): Call Vvod_Kopeek_Click: End Sub

Sub Vvod_Kopeek_Click()
TruePrice = Format(Roubles.Value & DecDelimiter & Copecks.Value, "currency")
MsgBox "Цена равна " & TruePrice
End Sub

Sub CommandButton0_Click(): Roubles.Value = Roubles.Value & "0": End Sub
Sub CommandButton1_Click(): Roubles.Value = Roubles.Value & "1": End Sub
Sub CommandButton2_Click(): Roubles.Value = Roubles.Value & "2": End Sub
Sub CommandButton3_Click(): Roubles.Value = Roubles.Value & "3": End Sub
Sub CommandButton4_Click(): Roubles.Value = Roubles.Value & "4": End Sub
Sub CommandButton5_Click(): Roubles.Value = Roubles.Value & "5": End Sub
Sub CommandButton6_Click(): Roubles.Value = Roubles.Value & "6": End Sub
Sub CommandButton7_Click(): Roubles.Value = Roubles.Value & "7": End Sub
Sub CommandButton8_Click(): Roubles.Value = Roubles.Value & "8": End Sub
Sub CommandButton9_Click(): Roubles.Value = Roubles.Value & "9": End Sub

Sub Deletion_Click()
With Roubles
    If Len(.Value) > 0 Then
    .Value = Left(.Value, Len(.Value) - 1)
    Else
    Copecks.Value = vbNullString 'когда стёрли рубли - стираем и копейки'
    End If
End With
End Sub

[Sasha_Smirnov]

Option Explicit
Dim TruePrice    'переменная для цены'

Sub EscapeButton_Click()
If Not Deletion.Enabled Then Deletion.Enabled = True Else Unload Me
End Sub

Sub SwitchToKeyboard_Click()
Copecks.Enabled = Not Copecks.Enabled
With SwitchToKeyboard
    If Copecks.Enabled Then
        .Caption = "Режим: ввод целых и сотых."
        .ForeColor = vbRed
    Else
        .Caption = "Режим: ввод только целых рублей.": Copecks.Value = "00"
        .ForeColor = vbBlack
    End If
End With
End Sub

Sub Vvod_Summy_Click()
TruePrice = Format(Roubles.Value & "," & Copecks.Value, "standard")
MsgBox "Цена равна:" & vbCr & TruePrice & vbCr & "(формат Standard)" & vbCr & vbCr & _
        Format(TruePrice, "fixed") & vbCr & "(формат Fixed)" & vbCr & vbCr & _
        Format(TruePrice, "currency") & vbCr & "(формат Currency)"
End Sub

'коды цифровых кнопок формы'
Sub CommandButton00_Click():  With Roubles: .Value = .Value & "00": End With: End Sub
Sub CommandButton0_Click():  With Roubles: .Value = .Value & "0": End With: End Sub
Sub CommandButton1_Click():  With Roubles: .Value = .Value & "1": End With: End Sub
Sub CommandButton2_Click():  With Roubles: .Value = .Value & "2": End With: End Sub
Sub CommandButton3_Click():  With Roubles: .Value = .Value & "3": End With: End Sub
Sub CommandButton4_Click():  With Roubles: .Value = .Value & "4": End With: End Sub
Sub CommandButton5_Click():  With Roubles: .Value = .Value & "5": End With: End Sub
Sub CommandButton6_Click():  With Roubles: .Value = .Value & "6": End With: End Sub
Sub CommandButton7_Click():  With Roubles: .Value = .Value & "7": End With: End Sub
Sub CommandButton8_Click():  With Roubles: .Value = .Value & "8": End With: End Sub
Sub CommandButton9_Click():  With Roubles: .Value = .Value & "9": End With: End Sub
Sub CommandButton99_Click():  With Roubles: .Value = .Value & "99": End With: End Sub

Sub Deletion_MouseMove _
(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'X и Y - это координаты указателя мыши на кнопке Deletion; Button и Shift - гонщики'
Static oddCall As Boolean: oddCall = Not oddCall       'нечётный вызов, для этой процедуры'

If oddCall Then
    TruePrice = Roubles.Value       'запоминаем содержимое поля, перед тем как его стереть'
    Roubles.Value = vbNullString    'обнуляем поле рублей'
    Deletion.Caption = "Вернуть"
Else
    Roubles.Value = TruePrice       'возвращаем содержимое поля, перед этим стёртого'
    Deletion.Caption = "Delete"
End If

Deletion.Enabled = False
End Sub

[Sasha_Smirnov]

Самое-то главное чуть не забыл: применение на практике! Прилагаю.
Это чисто ученический пример — моя первая* рабочая ВБА-форма!

Код «раздулся» вдвое, но по меркам Windows он не так уж и велик.

Option Explicit
Dim TruePrice                   'переменная для печати цены'
Dim rub, cop                    'целая и дробная части цен'
Dim DoneFirstRepeat As Boolean  'повтор ввода сделан (когда True)'
Dim LocalSettings(0 To 2) As String

Sub Localization()
Select Case Application.Keyboard 'индикатор раскладки клавиатуры'
Case 68748313 'русская раскладка'
    LocalSettings(0) = "Ввод цен в открытый документ"
    LocalSettings(1) = "Режим: ввод только целой части суммы."
    LocalSettings(2) = "Режим: ввод только дробной части."
    Delimiter.Caption = ","
    With Valuta: .Caption = "p.": .Left = 234: .Top = 36: End With
Case Else
    LocalSettings(0) = "You may put prices to the opened document"
    LocalSettings(1) = "Mode: you may not input fraction."
    LocalSettings(2) = "Mode: you may input fraction now."
    Delimiter.Caption = "."
    With Valuta: .Caption = "$": .Left = 36: .Top = 32: End With
End Select
Caption = LocalSettings(0)
End Sub

Sub EscapeButton_Click(): Unload Me         'выгрузка формы из памяти'
Selection.ParagraphFormat.TabStops.ClearAll 'сброс нововведённых установок табуляции'
End Sub

Sub SwitchToKeyboard_Click(): Static oddcounter As Boolean 'счётчик нечётности'
oddcounter = Not oddcounter '= True при нечётных пусках'
With SwitchToKeyboard
    If oddcounter Then
        Copecks.Enabled = True
        Roubles.Enabled = False
        .ForeColor = vbRed
        .Caption = LocalSettings(2)
    Else
        Copecks.Enabled = False
        Roubles.Enabled = True
        .ForeColor = vbBlack
        .Caption = LocalSettings(1)
    End If
End With
End Sub

Private Sub UserForm_Click()

End Sub

Sub Vvod_Summy_Enter() 'событие - фокус ввода на кнопке'
TruePrice = Format(Val(Val(Roubles.Value) & "." & Val(Copecks.Value)), "standard")
With Selection
.EndKey wdStory                 'переход в конец файла'
.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(14), Alignment:=wdAlignTabRight
.TypeText vbTab                 'печать табуляции (выровненной вправо на 14 см)'
.TypeText TruePrice             'печать цены из полей формы в открытый файл'
.TypeParagraph
End With
End Sub

Sub Vvod_Summy_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'событие - фокус ввода ушёл с кнопки'
If SwitchToKeyboard.Caption = LocalSettings(2) Then Call SwitchToKeyboard_Click 'возврат режима ввода целых'
With Roubles: .Enabled = True: rub = .Value: .Value = vbNullString: End With 'очистка поля рублей'
With Copecks: .Enabled = False: cop = .Value: .Value = vbNullString: End With 'очистка поля копеек'
End Sub

Sub Repetion_Click()
If Not DoneFirstRepeat Then Roubles.Value = Val(rub): Copecks.Value = Val(cop)
Call Vvod_Summy_Enter
End Sub

Sub Repetion_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'событие - фокус ввода ушёл с кнопки'
If SwitchToKeyboard.Caption = LocalSettings(2) Then Call SwitchToKeyboard_Click 'возврат режима ввода целых'
DoneFirstRepeat = False
With Roubles: .Enabled = True: rub = .Value: .Value = vbNullString: End With 'очистка поля рублей'
With Copecks: .Enabled = False: cop = .Value: .Value = vbNullString: End With 'очистка поля копеек'
End Sub

'коды цифровых кнопок формы'
Sub Button00_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "00": End With: End Sub
Sub Button0_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "0": End With: End Sub
Sub Button1_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "1": End With: End Sub
Sub Button2_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "2": End With: End Sub
Sub Button3_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "3": End With: End Sub
Sub Button4_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "4": End With: End Sub
Sub Button5_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "5": End With: End Sub
Sub Button6_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "6": End With: End Sub
Sub Button7_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "7": End With: End Sub
Sub Button8_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "8": End With: End Sub
Sub Button9_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "9": End With: End Sub
Sub Button99_Click(): With IIf(Roubles.Enabled, Roubles, Copecks): .Value = .Value & "99": End With: End Sub

Примечание: поменял в язык Региональных стандартах — по-английски стала форматировать!
________________
* столь многокнопочная

[Sasha_Smirnov]

Кстати, очень удобно вышеприведённую форму использовать для копирования цен (когда их штук 10—20) с магазинного чека.

Затем достаточно введённое выделить — нажать альт-S — и сверить сумму.

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

поменял в язык Региональных стандартах — по-английски стала форматировать

Поменял язык в..! Суть в том, что форматы с именем ("standard", "currency" etc.) преобразуют строку в зависимости от настройки числовых форматов в Панели управления Windows (раздел Язык и региональные стандарты).

[Sasha_Smirnov]

«Черновики» снёс, а вот более-менее устойчивый вариант (по альт-шифт-S).