View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Harald Staff Harald Staff is offline
external usenet poster
 
Posts: 1,327
Default Text Box for Numeric Data

"Chrissy" skrev i melding
...
Any chance of sending me the class?

Chrissy.


I'll post the general interest parts of it. Note that this is a VB6 class.
Forms2 textboxes and classes don't support all the events and properties, so
it takes some adjustments to squeeze itno a userform. Troublesome areas are
Clipboard content, GotFocus, LostFocus and textbox alignment. I know you're
good at this, Chrissy, so you take it from he

Option Explicit

Public WithEvents TextBox As TextBox
Public tbValue As Double
Public LDecimals As Long
Public DecSep As String

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

Private Sub TextBox_GotFocus()
With TextBox
.Alignment = 0
.SelStart = 0
.SelLength = Len(.Text)
.BackColor = RGB(255, 255, 170)
End With
End Sub

Private Sub TextBox_KeyDown(KeyCode As Integer, 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 Stmp As String
Dim D As Double
Dim L As Long
Stmp = Trim$(Clipboard.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 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(KeyAscii As Integer)
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 48 To 57 'numbers
Case Else 'Discard anything else
Beep
KeyAscii = 0
End Select
End Sub

Private Sub TextBox_KeyUp(KeyCode As Integer, Shift As Integer)
If CDbl(Me.TextBox.Text) = 0 Then
Me.tbValue = 0
Else
Me.tbValue = CDbl(Replace$(TextBox.Text, " ", ""))
End If
'Call external calculations here
End Sub

Private Sub TextBox_LostFocus()
TextBox.Alignment = 1
TextBox.BackColor = vbWhite
If 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 EnsureEntry()
Call TextBox_LostFocus
End Sub

Public Sub EmptyMe()
Me.TextBox.Text = ""
Call TextBox_LostFocus
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

--
HTH. Best wishes Harald
Followup to newsgroup only please