by Angsuman Banerji (23 Submissions)
Category: Custom Controls/Forms/Menus
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 6th November 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
The Code gives the Auto Fill Feature to a text box as available in Excel. (The Author dedicates the code to his wife Mrs. Anindita Banerjee)
API Declarations
Dim rsItem As New ADODB.Recordset
Dim i, j, c, d As Integer
Dim sqlrec As String
VBcoders
Sub SetTextbox(frm As Form, txtFocus As TextBox, flxOrder As MSFlexGrid)
frm.txtFocus.Visible = False
frm.txtFocus.Top = frm.flxOrder.Top + frm.flxOrder.CellTop
frm.txtFocus.Left = frm.flxOrder.Left + frm.flxOrder.CellLeft
frm.txtFocus.Height = frm.flxOrder.CellHeight
frm.txtFocus.Width = frm.flxOrder.CellWidth
frm.txtFocus.Text = frm.flxOrder.Text
frm.txtFocus.Visible = True
End Sub
'Public Sub FlxWork()
' flxorder.ColWidth(0) = TextWidth("99999")
' For i = 1 To flxorder.Rows - 1
' flxorder.TextMatrix(i, 0) = i
' txtfocus.Height = flxorder.CellHeight
' Next
' For i = 1 To flxorder.Cols - 1
' flxorder.TextMatrix(0, i) = Chr(64 + i)
' Next
' flxorder.Row = 1
' flxorder.Col = 1
' SetTextbox
'End Sub
Public Sub cmbLost(frm As Form, txtFocus As TextBox)
If frm.txtFocus.Visible = True Then
frm.txtFocus.SetFocus
End If
End Sub
Public Sub flxEnter(frm As Form)
With frm.flxOrder
If .Col = 1 Or .Col = 5 Or .Col = 6 And frm.boono = False Then
If frm.flxOrder.MouseRow = 0 Or frm.flxOrder.MouseCol = 0 Then
frm.txtFocus.Visible = False
Exit Sub
End If
' clear contents of current cell
frm.txtFocus.Text = ""
' place Textbox over current cell
frm.txtFocus.Visible = False
frm.txtFocus.Top = frm.flxOrder.Top + frm.flxOrder.CellTop
frm.txtFocus.Left = frm.flxOrder.Left + frm.flxOrder.CellLeft
frm.txtFocus.Width = frm.flxOrder.CellWidth
frm.txtFocus.Height = frm.flxOrder.CellHeight
' assing cell's contents to Textbox
frm.txtFocus.Text = frm.flxOrder.Text
' move focus to Textbox
frm.txtFocus.Visible = True
frm.txtFocus.SetFocus
End If
If .Col = 5 Or .Col = 6 Then
frm.txtFocus.Alignment = 1
ElseIf .Col = 1 Then
frm.txtFocus.Alignment = 0
End If
End With
End Sub
Public Sub flxLeave(frm As Form, txtFocus As TextBox, flxOrder As MSFlexGrid)
With frm.flxOrder
If .Col = 1 Or .Col = 5 Or .Col = 6 Then
frm.flxOrder.Text = frm.txtFocus.Text
End If
End With
End Sub
Public Sub txtChange(frm As Form, txtFocus As TextBox, flxOrder As MSFlexGrid)
If frm.flxOrder.Col = 1 Then
If frm.boo = True Then
AutoFillName frm.txtFocus, frm, txtFocus, flxOrder
End If
End If
End Sub
Public Sub AutoFillName(strFill As String, frm As Form, txtFocus As TextBox, flxOrder As MSFlexGrid)
frm.boo = False
On Error GoTo errRecords
If Not strFill = "" Then
Set rsItem = New ADODB.Recordset
sqlrec = "select Item_id,ItemName,MakersId,ArtNo,MRPrate,AvgRate from ItemMaster"
rsItem.Open sqlrec, con, adOpenKeyset, adLockOptimistic
If Not rsItem.EOF And Not rsItem.BOF Then rsItem.MoveFirst
rsItem.Find "ItemName Like '" & strFill & "%'", , adSearchForward, 1
If Not rsItem.EOF Then
frm.boono = False
frm.txtFocus.Text = rsItem.Fields("ItemName")
frm.flxOrder.Col = 3
frm.flxOrder.Text = rsItem.Fields("MakersId")
frm.flxOrder.Col = 4
frm.flxOrder.Text = rsItem.Fields("ArtNo")
frm.flxOrder.Col = 2
frm.flxOrder.Text = rsItem.Fields("Item_id")
frm.flxOrder.Col = 1
frm.flxOrder.Text = txtFocus.Text
gridWork strFill, frm, txtFocus, flxOrder
frm.flxShow.Visible = True
Else
frm.boono = True
i = 7
While i > 1
frm.flxOrder.TextMatrix(frm.flxOrder.row, i) = ""
i = i - 1
Wend
frm.flxOrder.Col = 1
frm.flxOrder.Text = frm.txtFocus.Text
frm.flxShow.Visible = False
End If
frm.txtFocus.SelStart = Len(strFill)
frm.txtFocus.SelLength = Len(frm.txtFocus.Text) - Len(strFill)
End If
Set rsItem = Nothing
errRecords:
Exit Sub
End Sub
Public Sub gridWork(st As String)
Dim sqlRec1 As String
frm.flxShow.Clear
Call frm.Heading1
If Not st = "" Then
Set rsSup = New ADODB.Recordset
sqlRec1 = "select Item_id,ItemName,MakersId,ArtNo,MRPrate,AvgRate from ItemMaster where ItemName Like '" & st & "%'"
rsSup.Open sqlRec1, con, adOpenKeyset, adLockOptimistic
End If
If rsSup.RecordCount > 0 Then
frm.flxShow.Visible = True
frm.flxShow.Rows = rsSup.RecordCount + 1
For i = 1 To rsSup.RecordCount
For j = 0 To 5
frm.flxShow.TextMatrix(i, j) = rsSup(j)
Next
rsSup.MoveNext
Next
' rsSup.Close
Else
frm.flxShow.Visible = False
End If
Set rsSup = Nothing
End Sub
'------------------------------Direct Writing In A FlexGrid------------------------------------------------------
'================================================================================================================
'''''''''''''Private Sub flxOrder_KeyPress(KeyAscii As Integer)
''''''''''''' If flxOrder.Row > 0 Then
''''''''''''' If flxOrder.Col = 5 Or flxOrder.Col = 6 Then
''''''''''''' If KeyAscii >= 48 And KeyAscii <= 57 And c = 0 Then
''''''''''''' flxOrder.Text = flxOrder.Text + Chr(KeyAscii)
''''''''''''' End If
''''''''''''' If KeyAscii = 46 And c = 0 Then
''''''''''''' c = c + 1
''''''''''''' flxOrder.Text = flxOrder.Text + Chr(KeyAscii)
''''''''''''' End If
''''''''''''' If KeyAscii >= 48 And KeyAscii <= 57 And c = 1 And d < 2 Then
''''''''''''' flxOrder.Text = flxOrder.Text + Chr(KeyAscii)
''''''''''''' d = d + 1
''''''''''''' End If
''''''''''''' If flxOrder.Text <> "" And KeyAscii = 8 Then
''''''''''''' flxOrder.Text = Mid(flxOrder.Text, 1, Len(flxOrder.Text) - 1)
''''''''''''' If InStr(1, flxOrder.Text, ".") = 0 Then
''''''''''''' c = 0
''''''''''''' d = 0
''''''''''''' Else
''''''''''''' d = d - 1
''''''''''''' End If
''''''''''''' End If
''''''''''''' End If
'''''''''''''' If flxOrder.Col = 1 Then
'''''''''''''' If KeyAscii = 13 Then
'''''''''''''' Call PopulateItemList
'''''''''''''' End If
'''''''''''''' End If
''''''''''''' End If
'''''''''''''End Sub
'''''''''''''
'=========================================================================================================
No comments have been posted about The Code gives the Auto Fill Feature to a text box as available in Excel. (The Author dedicates the. Why not be the first to post a comment about The Code gives the Auto Fill Feature to a text box as available in Excel. (The Author dedicates the.
