'Sample code for the menu editing form

Option Explicit
Dim InputString As String
Dim InputString1 As String
Dim curr_pos As Integer
Dim DB As Database
Dim RS As Recordset
Dim WS As Workspace
Dim max As Long
Dim i As Long
Dim errormsg
Dim dbadd As Boolean
Dim dbedit As Boolean
Dim actctrl As Control
Private Sub cmdbackspace_Click()


    On Error GoTo Err_Proc
Text1 = vbNullString
If (Len(InputString) > 0) Then
    InputString = Left(InputString, Len(InputString) - 1)
    curr_pos = 0
   ' findlistmatch
End If
Text1.Text = InputString
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdbackspace_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub
Private Sub cmdbackspace1_Click()


    On Error GoTo Err_Proc
Text2 = vbNullString
If (Len(InputString1) > 0) Then
    InputString1 = Left(InputString1, Len(InputString1) - 1)
    curr_pos = 0
   ' findlistmatch
End If
Text2.Text = InputString1
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdbackspace1_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub
Private Sub cmdKey_Click(Index As Integer)


    On Error GoTo Err_Proc
InputString = InputString + cmdKey(Index).Caption
Text1.Text = InputString
'findlistmatch
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdKey_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub cmdKey1_Click(Index As Integer)


    On Error GoTo Err_Proc
InputString1 = InputString1 + cmdKey1(Index).Caption
Text2.Text = InputString1
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdKey1_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub Command2_Click()


    On Error GoTo Err_Proc
InputString = InputString + " "
Text1.Text = InputString
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "Command2_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub
Private Sub cmdAdd_Click()


    On Error GoTo Err_Proc
Me.Height = 6990
Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
Text1.Text = vbNullString
Text2.Text = vbNullString
Text1.Enabled = True
Text2.Enabled = True
cmdAdd.Enabled = False
cmdDelete.Enabled = False
cmdEdit.Enabled = False
cmdend.Enabled = False
cmdsave.Enabled = True
cmdcancel.Enabled = True
dbadd = True
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdAdd_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub cmdcancel_Click()


    On Error GoTo Err_Proc
Text1.Text = vbNullString
Text1.Enabled = False
Text2.Text = vbNullString
Text2.Enabled = False
cmdsave.Enabled = False
cmdcancel.Enabled = False
cmdAdd.Enabled = True
cmdend.Enabled = True
Set RS = DB.OpenRecordset("tbldata", dbOpenTable)
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdcancel_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub cmdDelete_Click()


    On Error GoTo Err_Proc
errormsg = MsgBox("Are You Sure You Want To Delete This Record", vbYesNo, "Delete Record")
If errormsg = vbYes Then
RS.delete
Set RS = DB.OpenRecordset("tbldata", dbOpenTable)
list
Text1.Text = vbNullString
Text1.Enabled = False
Text2.Text = vbNullString
Text2.Enabled = False
cmdsave.Enabled = False
cmdcancel.Enabled = False
cmdAdd.Enabled = True

Else
Exit Sub
End If
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdDelete_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub cmdEdit_Click()


    On Error GoTo Err_Proc
Me.Height = 6990
Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
Text1.Enabled = True
Text2.Enabled = True
cmdAdd.Enabled = False
cmdDelete.Enabled = False
cmdEdit.Enabled = False
cmdend.Enabled = False
cmdsave.Enabled = True
cmdcancel.Enabled = True
dbedit = True
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdEdit_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub cmdend_Click()


    On Error GoTo Err_Proc
DB.Close
Unload Me

Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdend_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub cmdsave_Click()


    On Error GoTo Err_Proc
If Not ValidateNumeric(Text2.Text) Then
    MsgBox "Number error", vbExclamation
    Exit Sub
End If
If dbadd = True Then
    Call add
ElseIf dbedit = True Then
    Call edit
End If
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "cmdsave_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub Command1_Click()

    On Error GoTo Err_Proc
If Combo1.Text = "" Then
MsgBox "You must choose a database from the ComboBox Above", vbCritical
Exit Sub
Else
Set WS = DBEngine.Workspaces(0)
Set DB = WS.OpenDatabase(App.Path & "\" & Main.Label73.Caption & "\" & Combo1.Text & ".mdb")
Set RS = DB.OpenRecordset("tbldata", dbOpenTable)
Command1.Enabled = False
Combo1.Enabled = False
cmdend.Enabled = True
RemoveCancelMenuItem Me
list
End If
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "Command1_Click", Err, Err_Handle_Mode
    Resume Exit_Proc

End Sub
Public Function add()
If Text1.Text = vbNullString Or _
Text2.Text = vbNullString Then
    errormsg = MsgBox("All Fields Must Contain Data", vbCritical, "Error")
    Exit Function
End If
RS.AddNew
RS("Item") = Text1.Text
RS("Price") = Text2.Text
RS.Update
Text1.Text = vbNullString
Text1.Enabled = False
Text2.Text = vbNullString
Text2.Enabled = False
cmdsave.Enabled = False
cmdcancel.Enabled = False
cmdAdd.Enabled = True
cmdend.Enabled = True
Unload Tables
list
End Function
Public Function edit()
If Text1.Text = vbNullString Or _
Text2.Text = vbNullString Then
    errormsg = MsgBox("All Fields Must Contain Data", vbCritical, "Error")
    Exit Function
End If
RS.edit
RS("Item") = Text1.Text
RS("Price") = Text2.Text
RS.Update
Text1.Text = vbNullString
Text1.Enabled = False
Text2.Text = vbNullString
Text2.Enabled = False
cmdsave.Enabled = False
cmdcancel.Enabled = False
cmdAdd.Enabled = True
cmdend.Enabled = True
Set RS = DB.OpenRecordset("tbldata", dbOpenTable)
list

End Function

Private Sub Command3_Click()


    On Error GoTo Err_Proc
InputString1 = InputString1 + " "
Text2.Text = InputString1
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "Command3_Click", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub Form_Load()
Dim success As Long

    On Error GoTo Err_Proc
    success = SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
    
Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
With Combo1
.AddItem "Specials"
.AddItem "Comments"
.AddItem "Appetizers"
.AddItem "Seafood"
.AddItem "Poultry"
.AddItem "Steaks"
.AddItem "Pastas"
.AddItem "Sandwich"
.AddItem "Childrens"
.AddItem "Salads"
.AddItem "Bar"
.AddItem "Desserts"
.AddItem "Beverages"
End With
 InputString = vbNullString
 InputString1 = vbNullString
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "Form_Load", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Function list()
If RS.RecordCount = 0 Then
    errormsg = MsgBox("No Records Found", , "Error")
End If
RS.MoveLast
RS.MoveFirst
max = RS.RecordCount
RS.MoveFirst
List1.Clear
List2.Clear
For i = 1 To max
    List1.AddItem RS("Item")
    List2.AddItem RS("Price")
    RS.MoveNext
Next i
Label4.Caption = List1.ListCount
End Function


Private Sub List1_Click()
On Error Resume Next
Set RS = DB.OpenRecordset("Select * from tbldata where Item = '" & Trim(List1.list(List1.ListIndex)) & "'")
RS.MoveFirst
Text1.Text = RS("Item")
Text2.Text = RS("Price")
cmdEdit.Enabled = True
cmdDelete.Enabled = True
List2.Selected(List1.ListIndex) = True
End Sub
Private Sub Text1_GotFocus()


    On Error GoTo Err_Proc
Frame1.Visible = True
Frame2.Visible = False
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "Text1_GotFocus", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub

Private Sub Text2_GotFocus()


    On Error GoTo Err_Proc
Frame1.Visible = False
Frame2.Visible = True
Exit_Proc:
    Exit Sub


Err_Proc:
    Err_Handler " Editmenu ", "Text2_GotFocus", Err, Err_Handle_Mode
    Resume Exit_Proc


End Sub
Private Function ValidateNumeric(strText As String) _
    As Boolean
ValidateNumeric = CBool(strText = "" _
    Or strText = "-" _
     Or strText = "$" _
    Or strText = "-." _
    Or strText = "." _
    Or IsNumeric(strText))
End Function