|
THWatson (TechnicalUser) |
13 Mar 12 12:37 |
Using Access 2007 A database for my son-in-law who is an electrical contractor. On frmCustomers, there is a tab called Projects, which opens fsubProjects upon which Projects for individual customers. On that fsubProjects there is a fsubMaterials, in which are entered the Materials used for a particular Project being worked on. When I designed the database originally, he said that the standard Materials markup is 20% and I designed this to be calculated automatically...and in the background. He now says that he wants the capability to adjust this Markup. This would occur in a very small number of cases. Two possibilities occur to me. One is to check the Markup and adjust if desired. The other would be to apply a Materials discount. I would appreciate suggestions as how best to handle this. I will provide the code behind fsubMaterials. CODEOption Compare Database
Option Explicit
Private Sub Category_AfterUpdate()
Dim sql As String
sql = "SELECT ItemID, CategoryID, Item " & _
"FROM tblItems " & _
"WHERE ([CategoryID] = " & Me!Category.Column(0) & ") " & _
"ORDER BY tblItems.Item;"
Me!Item.RowSource = sql
'Me.Item.Requery
End Sub
Private Sub Category_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
On Error GoTo Category_NotInList_Error
If NewData = "" Then Exit Sub
Msg = """" & NewData & """ is not currently in the list." & vbCr & vbCr
Msg = Msg & "Do you want to add this Category?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Payee...")
If i = vbYes Then
strSQL = "Insert Into tblCategory ([Category]) values ('" & NewData & "')"
DoCmd.SetWarnings False
CurrentDb.Execute strSQL
Response = acDataErrAdded
DoCmd.SetWarnings True
Else
Response = acDataErrContinue
End If
On Error GoTo 0
Exit Sub
Category_NotInList_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Category_NotInList of VBA Document Form_fsubMaterials"
End Sub
Private Sub Form_AfterUpdate()
Dim sql As String
Dim SQL2 As String
On Error GoTo Form_AfterUpdate_Error
sql = "SELECT ItemID, CategoryID, Item " _
& "FROM tblItems " _
& "ORDER BY Item;"
Me.Item.RowSource = sql
SQL2 = "SELECT ItemTypeID, ItemID, ItemType " _
& " FROM tblItemType " _
& "ORDER BY ItemType;"
Me.[Item Type].RowSource = SQL2
On Error GoTo 0
Exit Sub
Form_AfterUpdate_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_AfterUpdate of VBA Document Form_fsubMaterials"
End Sub
Private Sub Form_BeforeInsert(Cancel As Integer)
If IsNull(Me.Parent!QuoteDate) Then
MsgBox "Please enter a Quote Date before entering Materials", vbExclamation
Cancel = True
Me.Parent!QuoteDate.SetFocus
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo Form_BeforeUpdate_Error
If Me.Parent!Accepted = True Then
Me.Invoice = True
Else
Me.Invoice = False
End If
On Error GoTo 0
Exit Sub
Form_BeforeUpdate_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_BeforeUpdate of VBA Document Form_fsubMaterials"
End Sub
Private Sub Form_Dirty(Cancel As Integer)
Me.ProjectID = Me.Parent!ProjectID
End Sub
Private Sub Item_AfterUpdate()
Dim SQL2 As String
SQL2 = "SELECT ItemTypeID, ItemID, ItemType " & _
"FROM tblItemType " & _
"WHERE ([ItemID] = " & Me!Item.Column(0) & ") " & _
"ORDER BY tblItemType.ItemType;"
Me![Item Type].RowSource = SQL2
'Me.[Item Type].Requery
End Sub
Private Sub Item_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
On Error GoTo Item_NotInList_Error
If NewData = "" Then Exit Sub
Msg = """" & NewData & """ is not currently in the list." & vbCr & vbCr
Msg = Msg & "Do you want to add this Item?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Payee...")
If i = vbYes Then
strSQL = "Insert Into tblItems ([Item],[CategoryID]) values ('" & NewData & "'," & Me.Category.Column(0) & ")"
DoCmd.SetWarnings False
CurrentDb.Execute strSQL
Response = acDataErrAdded
DoCmd.SetWarnings True
Else
Response = acDataErrContinue
End If
On Error GoTo 0
Exit Sub
Item_NotInList_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Item_NotInList of VBA Document Form_fsubMaterials"
End Sub
Private Sub Item_Type_NotInList(NewData As String, Response As Integer)
Dim strSQL As String
Dim i As Integer
Dim Msg As String
'Exit this sub if the combo box is cleared
On Error GoTo Item_Type_NotInList_Error
If NewData = "" Then Exit Sub
Msg = """" & NewData & """ is not currently in the list." & vbCr & vbCr
Msg = Msg & "Do you want to add this Item Type?"
i = MsgBox(Msg, vbQuestion + vbYesNo, "Unknown Payee...")
If i = vbYes Then
strSQL = "Insert Into tblItemType ([ItemType],[ItemID]) values ('" & NewData & "'," & Me.Item.Column(0) & ")"
DoCmd.SetWarnings False
CurrentDb.Execute strSQL
Response = acDataErrAdded
DoCmd.SetWarnings True
Else
Response = acDataErrContinue
End If
On Error GoTo 0
Exit Sub
Item_Type_NotInList_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Item_Type_NotInList of VBA Document Form_fsubMaterials"
End Sub Thanks for assistance. Tom |
|
Talk To Other Members
Read More Threads Like This One