locking textbox?!

[jason]

Hello All,

i have a textbox that has to have a number entered into it that is >0
& <10.
i can quite easily write a longish routine in the textbox_change event
procedure using isnumeric & len() to test each new character that the
user inputs into the textbox

; but is there a quicker solution?


Thanks in advance
Jason

 

[Tom Ogilvy]

; but is there a quicker solution?

use someone else's code (someone that has already invested the time). You
will need to add some code to restrict it to numbers between 0 and 10.

Code posted by Harald Staff:

Harald Staff:

Class for numeric data in a textbox:

Ok, from the top:
New Excel file.
Add a Userform1 containing Textbox1 and Textbox2.
Add a class module (Insert menu). Name the class "NumTxt" in the properties
window.
Paste this into the class module:

'**************************
Option Explicit

Public WithEvents TextBox As MSForms.TextBox
Public tbValue As Double
Public LDecimals As Long
Public Negatives As Boolean
Public DecSep As String

Private Sub Class_Initialize()
Me.DecSep = Mid$(Format(1.5, "0.0"), 2, 1)
Me.Negatives = True
End Sub

Public Sub EnterMe()
With TextBox
.SelStart = 0
.SelLength = Len(.Text)
.BackColor = RGB(255, 255, 170)
End With
End Sub

Private Sub TextBox_KeyDown(ByVal KeyCode As _
MSForms.ReturnInteger, ByVal Shift As Integer)
Dim Btmp As Boolean
If KeyCode = 86 And Shift = 2 Then
KeyCode = 0
TextBox.SelText = ""
Btmp = CBool(Me.LDecimals)
If InStr(TextBox.Text, DecSep) > 0 Then Btmp = False
Debug.Print TextBox.Text, InStr(TextBox.Text, DecSep)
TextBox.SelText = PastedText(Btmp)
End If
End Sub

Private Function PastedText(ByVal AllowDecSep As Boolean) As String
Dim MyDataObj As New DataObject
Dim Stmp As String
Dim D As Double
Dim L As Long

MyDataObj.GetFromClipboard
Stmp = Trim$(MyDataObj.GetText)
Debug.Print AllowDecSep, Stmp
For L = 1 To Len(Stmp)
Select Case Asc(Mid$(Stmp, L))
Case 44, 46
If AllowDecSep Then
PastedText = PastedText & DecSep
AllowDecSep = False
End If
Case 45
If Me.Negatives And TextBox.SelStart = 0 And _
(Len(PastedText) = 0) Then _
PastedText = "-"
Case 48 To 57 'numbers
PastedText = PastedText & Mid$(Stmp, L, 1)
Case Else
End Select
Next

On Error Resume Next
D = CDbl(PastedText)
If D <> 0 Then
PastedText = CStr(D)
Else
PastedText = ""
End If
Debug.Print PastedText
Debug.Print
End Function

Private Sub TextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 8 To 10, 13, 27 'Control characters
Case 44, 46
If Me.LDecimals > 0 And InStr(TextBox.Text, DecSep) = 0 Then
KeyAscii = Asc(DecSep)
Else
Beep
KeyAscii = 0
End If
Case 45
If Me.Negatives And TextBox.SelStart = 0 Then
Else
Beep
KeyAscii = 0
End If
Case 48 To 57 'numbers
Case Else 'Discard anything else
Beep
KeyAscii = 0
End Select
End Sub

Private Sub TextBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal
Shift As Integer)
On Error Resume Next
If IsError(CDbl(Me.TextBox.Text)) Then
Me.tbValue = 0
ElseIf CDbl(Me.TextBox.Text) = 0 Then
Me.tbValue = 0
Else
Me.tbValue = CDbl(Replace$(TextBox.Text, " ", ""))
End If
Call UserForm1.CalculateMe
End Sub

Public Sub ExitMe()
TextBox.BackColor = vbWhite
On Error Resume Next
If IsError(CDbl(Me.TextBox.Text)) Then
Me.tbValue = 0
'ElseIf Trim$(TextBox.Text) = "" Then
' Me.tbValue = 0
Else
Me.tbValue = CDbl(Replace$(TextBox.Text, " ", ""))
End If
TextBox.Text = Decorated(Me.tbValue, Me.LDecimals)
End Sub

Public Sub EmptyMe()
Me.TextBox.Text = ""
Call ExitMe
End Sub

Private Function Decorated(DNumber As Double, Optional LDecimals As Long) As
String
Dim sDes As String
If LDecimals > 0 Then
sDes = "." & String(LDecimals, "0")
Else
sDes = ""
End If
Decorated = Format(DNumber, "# ### ### ##0" & sDes)
Decorated = Trim$(Decorated)
End Function

'**************************************

Now back to the userform. Paste this into its module:

'**************************************
Option Explicit

Dim Num1 As New NumTxt
Dim Num2 As New NumTxt

Private Sub UserForm_Initialize()
Set Num1.TextBox = Me.TextBox1
Num1.LDecimals = 2 'decimals allowed, display two
Set Num2.TextBox = Me.TextBox2
Num2.Negatives = False 'no negative numbers, no decimals
End Sub

Private Sub TextBox1_Enter()
Call Num1.EnterMe
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call Num1.ExitMe
End Sub

Private Sub TextBox2_Enter()
Call Num2.EnterMe
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call Num2.ExitMe
End Sub

Public Sub CalculateMe()
Me.Caption = "Product: " & Num1.tbValue * Num2.tbValue
End Sub

'**************************************

Now run it. Enter stuff, paste stuff with Ctrl V, watch things happen when
you type and when you tab between the boxes.

 

[jason]

Tom,

1. Thanks loads for this excellent code.
2. Thanks for the inspiration to try to at last get my head around
class modules

All the best
Jason

p.s Did you design the Google/Web site Search application excel
add-in? I use it at work, but because the code is password protected
I'm being told that I have to get rid of it (potential virus risk - is
there a way of fully checking for viruses if project is password
protected??) - so I was hoping to get the password so that I can carry
on using it!!

 

[Tom Ogilvy]

I believe that is the product of Ron de Bruin

I doubt you can check it without unprotecting it. Perhaps Ron can do
something for you.

http://www.rondebruin.nl

or get his email off one of his postings.

 

[TroyW]

Jason,

1) Can you wait until the user clicks a commandbutton (OK/Done button) and
then validate the textbox.

2) Can you use the Textbox_Exit event?(see code below) I don't know if your
design fits this usage (requires the user to hit enter or tab to another
control).

Troy


Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim sValue As String
Dim dblValue As Double

sValue = Me.TextBox1.Value
If IsNumeric(sValue) Then
dblValue = CDbl(sValue)
If dblValue <= 0 Or dblValue >= 10 Then
MsgBox "Please enter a number between 0 and 10"
Cancel = True
End If
Else
MsgBox "Please enter a numeric value"
Cancel = True
End If
End Sub