📄 frm_modify_purchase_book.frm
字号:
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
ColumnWidth = 3000.189
EndProperty
BeginProperty Column01
ColumnWidth = 915.024
EndProperty
BeginProperty Column02
ColumnWidth = 1005.165
EndProperty
BeginProperty Column03
ColumnWidth = 1500.095
EndProperty
BeginProperty Column04
ColumnWidth = 3495.118
EndProperty
EndProperty
End
Begin LVbuttons.LaVolpeButton cmd_update
Height = 375
Left = 7080
TabIndex = 17
Top = 6480
Width = 2175
_ExtentX = 3836
_ExtentY = 661
BTYPE = 3
TX = "&Update Invoice"
ENAB = -1 'True
BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
COLTYPE = 2
BCOL = 14737632
FCOL = 0
FCOLO = 0
EMBOSSM = 12632256
EMBOSSS = 16777215
MPTR = 0
MICON = "FRM_MODIFY_PURCHASE_BOOK.frx":0F3F
ALIGN = 1
IMGLST = "(None)"
IMGICON = "(None)"
ICONAlign = 0
ORIENT = 0
STYLE = 0
IconSize = 2
SHOWF = -1 'True
BSTYLE = 0
End
Begin VB.Label issues
BackStyle = 0 'Transparent
Caption = "Please Be Sure while Modifing Purchase entry in to purchase Master."
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1440
TabIndex = 31
Top = 480
Width = 8895
End
Begin VB.Label Label2
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "Modify Purchase Entry Form"
BeginProperty Font
Name = "Verdana"
Size = 15.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 495
Left = 240
TabIndex = 30
Top = 0
Width = 5175
End
Begin VB.Image Image1
Height = 840
Left = 0
Picture = "FRM_MODIFY_PURCHASE_BOOK.frx":0F5B
Stretch = -1 'True
Top = 0
Width = 9360
End
End
Attribute VB_Name = "FRM_MODIFY_PURCHASE_BOOK"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim pur_rs As New ADODB.Recordset
Dim item_rs As New ADODB.Recordset
Dim item_type As New ADODB.Recordset
Dim rs_cur_invoice_item As New ADODB.Recordset
Dim rs_grid As New ADODB.Recordset
Dim rs_cur_record_count As New ADODB.Recordset
Dim pname As New ADODB.Recordset
Dim Status As Boolean
Public PADD As Boolean
Public TOTAL_TRAN_AMT As Double
Private Sub cmd_op_Click(Index As Integer)
If Index = 0 Then
If Combo3.Enabled = False Then
SendKeys "{TAB}"
Else
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
End If
Call opbutton_status(False)
ENABLE_DISABLE (True)
rs_cur_invoice_item.AddNew
clear_box
Status = True
cmd_update.Enabled = False
ElseIf Index = 1 Then
If Len(Combo2.Text) > 0 And Len(Combo1.Text) > 0 And VAL(Text1(2).Text) > 0 And VAL(Text1(3).Text) > 0 And VAL(Text1(4).Text) > 0 Then
rs_cur_invoice_item.Fields(0).Value = Combo2.Text
rs_cur_invoice_item.Fields(1).Value = Combo1.Text
rs_cur_invoice_item.Fields(2).Value = Text1(2).Text
rs_cur_invoice_item.Fields(3).Value = Text1(3).Text
rs_cur_invoice_item.Fields(4).Value = Text1(4).Text
rs_cur_invoice_item.Fields(5).Value = Text1(5).Text
On Error GoTo updateerr:
rs_cur_invoice_item.Update
rs_cur_invoice_item.UpdateBatch
Set DataGrid1.DataSource = Nothing
rs_cur_invoice_item.Requery
Set DataGrid1.DataSource = rs_cur_invoice_item
ENABLE_DISABLE (False)
opbutton_status (True)
Status = False
cmd_update.Enabled = True
If Combo3.Enabled = False Then
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
Else
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
End If
Exit Sub
updateerr:
rs_cur_invoice_item.CancelBatch
rs_cur_invoice_item.CancelUpdate
rs_cur_invoice_item.Requery
MsgBox "Item is already Exist in the bill" & vbCrLf & "Update Qty in the existing item entry ...", vbCritical, "Error: Duplicate item entry ..."
ENABLE_DISABLE (False)
opbutton_status (True)
Status = False
cmd_update.Enabled = True
Else
MsgBox "Enter Proper and Sufficient Data", vbCritical, "Check your Data ..."
End If
ElseIf Index = 2 Then
rs_cur_record_count.Requery
If rs_cur_record_count.Fields(0).Value > 0 Then
rs_cur_invoice_item.Delete
rs_cur_invoice_item.MoveNext
If rs_cur_invoice_item.EOF <> True Then
Call FILLTEXT
Else
rs_cur_record_count.Requery
If rs_cur_record_count.Fields(0).Value > 0 Then
rs_cur_invoice_item.MoveLast
Call FILLTEXT
Else
clear_box
MsgBox "All Items Deleted ...", vbInformation, "Items Deleted.."
If Combo1.Enabled = False Then
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
Else
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
End If
End If
End If
Else
clear_box
MsgBox "All Items Deleted ...", vbInformation, "Items Deleted.."
End If
ElseIf Index = 3 Then
rs_cur_record_count.Requery
If rs_cur_record_count.Fields(0).Value > 0 Then
ENABLE_DISABLE (True)
opbutton_status (False)
cmd_update.Enabled = False
End If
ElseIf Index = 4 Then
Status = False
rs_cur_record_count.Requery
rs_cur_invoice_item.CancelBatch
rs_cur_invoice_item.CancelUpdate
rs_cur_invoice_item.Requery
If rs_cur_record_count.Fields(0).Value > 0 Then
rs_cur_invoice_item.MoveFirst
Else
clear_box
End If
Call opbutton_status(True)
ENABLE_DISABLE (False)
cmd_update.Enabled = True
End If
End Sub
Private Sub cmd_op_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If Index = 0 Then
If KeyCode = 13 Then
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
End If
End If
End Sub
Private Sub cmd_update_Click()
Dim t As Integer
t = MsgBox("Are you sure you want to save purchase bill", vbQuestion Or vbYesNo, "Want to save Purchase bill")
If t = 7 Then
Exit Sub
End If
Call delete_old_rows
Dim RS_AVA_PU_STOCK As New ADODB.Recordset
RS_AVA_PU_STOCK.Open "SELECT * FROM AVAILABLE_PURCHASED_STOCK", db, adOpenDynamic, adLockOptimistic
rs_cur_invoice_item.Requery
rs_cur_record_count.Requery
If rs_cur_record_count.Fields(0).Value > 0 Then
If Len(Text1(0).Text) > 0 And Len(Combo3.Text) > 0 Then
TOTAL_TRAN_AMT = TOTAL_AMT("PURCHASE")
While rs_cur_invoice_item.EOF <> True
pur_rs.AddNew
pur_rs.Fields(0).Value = Text1(0).Text
pur_rs.Fields(1).Value = Combo3.Text
pur_rs.Fields(2).Value = DTPicker1.Value
pur_rs.Fields(3).Value = rs_cur_invoice_item.Fields(0).Value
pur_rs.Fields(4).Value = rs_cur_invoice_item.Fields(1).Value
pur_rs.Fields(5).Value = rs_cur_invoice_item.Fields(2).Value
pur_rs.Fields(6).Value = rs_cur_invoice_item.Fields(3).Value
pur_rs.Fields(7).Value = rs_cur_invoice_item.Fields(4).Value
If Len(rs_cur_invoice_item.Fields(5).Value) > 0 Then
pur_rs.Fields(8).Value = rs_cur_invoice_item.Fields(5).Value
End If
On Error GoTo OH_ER
pur_rs.Update
GoTo A1:
OH_ER:
MsgBox "Duplicate Entry Found ...", vbCritical, "Duplicate Entry Found ..."
pur_rs.CancelUpdate
Exit Sub
A1:
RS_AVA_PU_STOCK.AddNew
RS_AVA_PU_STOCK.Fields(0).Value = Text1(0).Text
RS_AVA_PU_STOCK.Fields(1).Value = Combo3.Text
RS_AVA_PU_STOCK.Fields(2).Value = DTPicker1.Value
RS_AVA_PU_STOCK.Fields(3).Value = rs_cur_invoice_item.Fields(0).Value
RS_AVA_PU_STOCK.Fields(4).Value = rs_cur_invoice_item.Fields(1).Value
RS_AVA_PU_STOCK.Fields(5).Value = rs_cur_invoice_item.Fields(2).Value
RS_AVA_PU_STOCK.Fields(6).Value = rs_cur_invoice_item.Fields(3).Value
RS_AVA_PU_STOCK.Fields(7).Value = rs_cur_invoice_item.Fields(4).Value
RS_AVA_PU_STOCK.Fields(8).Value = rs_cur_invoice_item.Fields(5).Value
RS_AVA_PU_STOCK.Update
item_rs.Close
item_rs.Open "select * from item_master where Itemtype='" & rs_cur_invoice_item.Fields(0).Value & "' and Item_name='" & rs_cur_invoice_item.Fields(1).Value & "'", db, adOpenDynamic, adLockOptimistic
item_rs.Fields(3).Value = VAL(item_rs.Fields(3).Value) + VAL(rs_cur_invoice_item.Fields(2).Value)
item_rs.Update
rs_cur_invoice_item.MoveNext
Wend
rs_cur_invoice_item.MoveFirst
While rs_cur_invoice_item.EOF <> True
rs_cur_invoice_item.Delete
rs_cur_invoice_item.MoveNext
Wend
PADD = False
FRM_AMT_PAID_NOT_PAID.Label3(5).Caption = "Purchase"
FRM_AMT_PAID_NOT_PAID.Label3(2).Caption = Text1(0).Text
FRM_AMT_PAID_NOT_PAID.Label3(0).Caption = Combo3.Text
FRM_AMT_PAID_NOT_PAID.dt = Format(DTPicker1.Value, "dd-MMM-yyyy")
FRM_AMT_PAID_NOT_PAID.Label2(2).Caption = TOTAL_TRAN_AMT
Unload Me
'Dim f As New FileSystemObject
'f.CopyFile App.Path & "\Master_Database.mdb", App.Path & "\data\" & cur_company_name & "\Master_Database.mdb", True
FRM_AMT_PAID_NOT_PAID.Show vbModal
Else
MsgBox "Enter Proper data" & vbCrLf & "Some Important Data are missing", vbCritical, "Enter Proper Data ..."
End If
Else
MsgBox "There is no item in this Purchase bill , You can not save it ...", vbInformation, "No item Found.."
End If
RS_AVA_PU_STOCK.Close
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If Len(Combo1.Text) > 0 Then
If KeyCode = 13 Then
SendKeys "{TAB}"
SendKeys "{TAB}"
End If
End If
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer)
'KeyAscii = 0
End Sub
Private Sub Combo2_Click()
Refresh_combobox (1)
End Sub
Private Sub Combo2_KeyDown(KeyCode As Integer, Shift As Integer)
If Len(Combo2.Text) > 0 Then
If KeyCode = 13 Then
SendKeys "{TAB}"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -