?? frmpsout.frm
字號:
.TextMatrix(.rows - 1, 6) = txt_total.text
.rows = .rows + 1
End With
With flex_pro
.TextMatrix(.row, 4) = Val(.TextMatrix(.row, 4)) - Val(msglist.TextMatrix(msglist.rows - 2, 5))
End With
totalprice
CmdAct(7).SetFocus
Case 3
If msglist.rows > 2 And msglist.TextMatrix(msglist.row, 1) <> "" Then
ru = MsgBox("確認刪除?", 33, "詢問")
If ru = 2 Then
Exit Sub
End If
With flex_pro
For ru = 1 To .rows - 1
If Trim$(.TextMatrix(ru, 0)) = Trim$(msglist.TextMatrix(msglist.row, 1)) Then
.TextMatrix(ru, 4) = Val(.TextMatrix(ru, 4)) + Val(msglist.TextMatrix(msglist.row, 5))
Exit For
End If
Next ru
End With
msglist.RemoveItem (msglist.row)
For ru = 1 To msglist.rows - 1
msglist.TextMatrix(msglist.rows - ru, 0) = msglist.rows - ru
Next ru
Else
MsgBox "本行不能刪除！", vbInformation, "信息"
End If
totalprice
CmdAct(7).SetFocus
Case 4
If yesno1 = False Then
frm_cgreport.Show
Else
If msglist.rows > 2 And cmdSave.Enabled = True Then
ru = MsgBox("放棄當前銷售的數據?", 33, "詢問")
If ru = 2 Then
Exit Sub
End If
End If
End If
Unload Me
Case 5
txt_id = ""
txt_qty = 0
txtsa_maker.text = strCurUser
dtptime.Value = Now
'Comsupp = ""
txt_memo = ""
Combtype.Clear
TxtSQL = "select employee_name from Employee "
Set mrc = ExecuteSQL(TxtSQL, msgtext)
Combtype.AddItem " "
Do While Not mrc.EOF
Combtype.AddItem mrc.Fields("employee_name")
mrc.MoveNext
Loop
Combtype.ListIndex = 0
msglist.Clear
showtitle
mrc.Close
Set mrc = Nothing
strsql = "select CountNum from counterid where TableName='psout_head'"
rscount.Open strsql, cnn, adOpenDynamic, adLockOptimistic
txtsa_id.text = Format(rscount!CountNum + 1, "00000")
Call IsEdit(True)
rscount.Close
Combtype.SetFocus
Case 6
txt_qty = 0
txt_name = ""
txt_id = ""
txt_total = ""
txt_lb = ""
combdj = ""
combdw = ""
txt_id.Enabled = True
txt_id.SetFocus
Case 7
txt_qty.text = 0
txt_name = ""
txt_id = ""
txt_total = ""
txt_lb = ""
combdj = ""
combdw = ""
txt_id.Enabled = True
txt_id.SetFocus
SendKeys "{Home}+{End}"
Case 8
Set txt = New clsText
With txt
.stringX = " "
.fontsize = 10
.Align = tymiddle
End With
rpt.Title.AddText "title2", txt
Set txt = Nothing
rpt.SetPrinter 11500.488, 13000.064, Portrait
Set txt = New clsText
With txt
.stringX = "出庫單"
.fontsize = 12
.FontBold = True
.Align = tymiddle
End With
rpt.Header.AddText "head1", txt
Set txt = Nothing
Set txt = New clsText
rpt.Header.AddText "head2", txt
Set txt = Nothing
Set txt = New clsText
With txt
.stringX = "單號:" & txtsa_id & Space(10) & "日期:" & dtptime.Value & Space(5)
.fontsize = 10
'.ForeColor = &H8000&
'.FontBold = True
.Align = tyLeft
.orient = Portrait
End With
rpt.Header.AddText "head3", txt
Set txt = Nothing
Set txt = New clsText
With txt
.stringX = "領用人:" & Combtype.text & Space(10) & "領用部門:" & Comsupp.text & Space(5)
.fontsize = 10
'.ForeColor = &H8000&
'.FontBold = True
.Align = tyLeft
.orient = Portrait
End With
rpt.Header.AddText "head4", txt
Set txt = Nothing
Set txt = New clsText
With txt
.stringX = "總成本價：" & Format(Label2.Caption, "0.000") & Space(5) & "總銷售價：" & Format(Label1.Caption, "0.00") & Space(5) & "|制單人:" & txtsa_maker
.fontsize = 10
'.ForeColor = vbRed
'.FontBold = True
.Align = tyLeft
End With
rpt.Footer.AddText "footer1", txt
Set txt = Nothing
rpt.LeftSection.AlignMode = tyContent
rpt.RightSection.AlignMode = tyContent
rpt.Align = tymiddle
BTarray(1) = 800
BTarray(2) = 3400
BTarray(3) = 600
BTarray(4) = 600
BTarray(5) = 1100
BTarray(6) = 1200
BTarray(7) = 1100
BTarray(8) = 1200
recBT(1) = "編號"
recBT(2) = "名稱"
recBT(3) = "數量"
recBT(4) = "單位"
recBT(5) = "進價"
recBT(6) = "金額"
recBT(7) = "售價"
recBT(8) = "金額"
TxtSQL = "select a.p_id,a.p_name,a.qty,a.unit,format(a.unit_price,'0.000'),format(a.price,'0.000'),format(b.product_pst,'0.00'),format(a.qty*b.product_pst,'0.00') as sp"
TxtSQL = TxtSQL & " from psout_detail as a, product as b where a.p_id = b.p_id and order_id='" & txtsa_id & "'"
Set mrc = ExecuteSQL(TxtSQL, msgtext)
If mrc.EOF Then Exit Sub
report = False
rpt.Attachmrc mrc, recBT, BTarray
rpt.Preview
mrc.Close
Set mrc = Nothing
End Select
Exit Sub
Err:
MsgBox "錯誤號為：" & Err.Number & Chr(13) & "錯誤說明：" & Err.Description
'Resume Next
End Sub
Private Sub IsEdit(blnIsEdit As Boolean)
Dim intNum As Integer
txt_id.Enabled = blnIsEdit
Comsupp.Enabled = blnIsEdit
Combtype.Enabled = blnIsEdit
cmdSave.Enabled = blnIsEdit
' combdw.Enabled = blnIsEdit
txt_memo.Enabled = blnIsEdit
' txt_name.Enabled = blnIsEdit
dtptime.Enabled = blnIsEdit
txt_qty.Enabled = blnIsEdit
' combdj.Enabled = blnIsEdit
msglist.Enabled = blnIsEdit
flex_pro.Enabled = blnIsEdit
For intNum = 2 To 3
CmdAct(intNum).Enabled = blnIsEdit
Next
'CmdAct(1).Enabled = Not blnIsEdit
CmdAct(5).Enabled = Not blnIsEdit
CmdAct(6).Enabled = blnIsEdit
CmdAct(7).Enabled = blnIsEdit
If txtsa_id = "" Then
For intNum = 2 To 3
CmdAct(intNum).Enabled = False
Next
End If
End Sub
Private Sub DCbouser_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
CmdAct(2).SetFocus
End If
End Sub
Private Sub cmdSave_Click()
saveyesno = True
If Combtype.text = "" Then
MsgBox "領物人未填!", vbCritical, "錯誤"
Combtype.SetFocus
Exit Sub
End If
If msglist.rows <= 2 Then
MsgBox "單據明細項不能為空!", vbCritical, "錯誤"
Exit Sub
End If
If MsgBox("確認出庫?", 33, "出庫") = 2 Then
Exit Sub
End If
Dim i As Long
On Error GoTo errdeal
cnn.BeginTrans
With msglist
For i = 1 To .rows - 1
If Trim$(.TextMatrix(i, 1)) <> "" Then
updatesales i
End If
Next
End With
cnn.Execute "update counterid set CountNum=CountNum+1 where TableName='psout_head' and val(countnum)< " & Val(txtsa_id.text)
cnn.CommitTrans
MsgBox "數據保存完畢！", vbInformation
On Error Resume Next
Call IsEdit(False)
CmdAct(8).Enabled = True
CmdAct(8).SetFocus
Exit Sub
errdeal:
MsgBox " 保存失敗，請檢查每個項目的正確性。" & Err.Description, vbCritical
Err.Clear
End Sub
Private Sub Combdj_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
CmdAct(2).SetFocus
End If
End Sub
Private Sub Combtype_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Comsupp_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub flex_pro_Click()
If flex_pro.row > 0 Then
With flex_pro
txt_id = "" & .TextMatrix(.row, 0)
txt_name = "" & .TextMatrix(.row, 1)
combdj = "" & .TextMatrix(.row, 3)
combdw = "" & .TextMatrix(.row, 2)
txt_qty.Enabled = True
txt_qty.text = 1
num = Val("" & .TextMatrix(.row, 4))
txt_qty.SetFocus
SendKeys "{Home}+{End}"
End With
End If
End Sub
Private Sub Form_Load()
Dim mrc As ADODB.Recordset
Dim TxtSQL As String
Dim msgtext As String
Set rsProduct = DEjxc.rsComproductbycode
Set cmProduct = New ADODB.Command
cmProduct.ActiveConnection = cnn
cmProduct.CommandType = adCmdText
Set rsSaHA = DEjxc.rsComPsHA
Set rsSalDA = DEjxc.rsComOrdDA
Set rscount = New ADODB.Recordset
Set rssql = New ADODB.Recordset
Set cmSaHA = New ADODB.Command
cmSaHA.ActiveConnection = cnn
cmSaHA.CommandType = adCmdText
showtitle
If yesno1 = False Then
cmdSave.Visible = False
' CmdAct(1).Visible = False
CmdAct(2).Visible = False
CmdAct(3).Visible = False
CmdAct(5).Visible = False
' CmdAct(6).Visible = False
CmdAct(7).Visible = False
CmdAct(8).Visible = False
txtsa_id = frm_cgreport.msglist1.TextMatrix(frm_cgreport.msglist1.row, 0)
TxtSQL = "select ps_id,ps_date,ps_rid,ps_maker,ps_men,ps_demo"
TxtSQL = TxtSQL & " from psout_head"
TxtSQL = TxtSQL & " where ps_id='" & txtsa_id & "'"
Set mrc = ExecuteSQL(TxtSQL, msgtext)
If mrc.EOF Then Exit Sub
txtsa_maker = "" & mrc.Fields("ps_maker")
Combtype = "" & mrc.Fields("ps_men")
Comsupp.ItemData(Comsupp.ListIndex) = "" & mrc.Fields("ps_rid")
dtptime.Value = mrc.Fields("ps_date")
txt_memo = "" & mrc.Fields("ps_demo")
TxtSQL = "select * from psout_detail where order_id='" & txtsa_id & "'"
Set mrc = ExecuteSQL(TxtSQL, msgtext)
If mrc.EOF Then Exit Sub
Do While Not mrc.EOF
With FrmPsEdit.msglist
.TextMatrix(.rows - 1, 0) = .rows - 1
.TextMatrix(.rows - 1, 1) = mrc.Fields("p_id")
.TextMatrix(.rows - 1, 2) = mrc.Fields("p_name")
.TextMatrix(.rows - 1, 3) = mrc.Fields("unit")
.TextMatrix(.rows - 1, 4) = mrc.Fields("unit_price")
.TextMatrix(.rows - 1, 5) = mrc.Fields("qty")
.TextMatrix(.rows - 1, 6) = mrc.Fields("price")
.TextMatrix(.rows - 1, 7) = "" & mrc.Fields("type_id")
.rows = .rows + 1
mrc.MoveNext
End With
Loop
msglist.Enabled = True
mrc.Close
Set mrc = Nothing
totalprice
Else
Call IsEdit(False)
intNumWindows = OpenWindow(intNumWindows)
Call SetFormStu(Me, frmMain)
End If
TxtSQL = "select a.p_id,a.p_name,a.unit,b.product_cos,format(a.qty,'0') as qty,format(a.price,'0.00') as price,b.product_code,b.product_eno"
TxtSQL = TxtSQL & " from mat_detail as a,product as b"
TxtSQL = TxtSQL & " where a.p_id=b.p_id"
TxtSQL = TxtSQL & " and (a.p_id<>'' and a.qty<>0)"
TxtSQL = TxtSQL & " group by a.p_id,a.p_name,a.unit,b.product_cos,a.qty,a.price,b.product_code,b.product_eno,b.type_id"
TxtSQL = TxtSQL & " order by b.type_id,a.p_name,a.p_id"
Set mrc = ExecuteSQL(TxtSQL, msgtext)
Set flex_pro.DataSource = mrc
showtitle_pro
flex_pro.Visible = False
Comsupp.Clear
TxtSQL = "select department_id,department_name from Department order by val(department_id) "
Set mrc = ExecuteSQL(TxtSQL, msgtext)
Do While Not mrc.EOF
Comsupp.AddItem mrc.Fields("department_name")
Comsupp.ItemData(Comsupp.NewIndex) = mrc.Fields("department_id")
mrc.MoveNext
Loop
Comsupp.ListIndex = 0
mrc.Close
Set mrc = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
intNumWindows = Closewindow(intNumWindows)
'rscount.Close
Set rsSaHA = Nothing
Set rsSalDA = Nothing
'Set rscount = Nothing
Set cmSaHA = Nothing
Set cmProduct = Nothing
End Sub
Private Sub msglist_DblClick()
If msglist.rows = 1 Or msglist.TextMatrix(msglist.row, 1) = "" Then
Exit Sub
End If
With msglist
txt_id.text = .TextMatrix(.row, 1)
txt_name.text = .TextMatrix(.row, 2)
combdw = .TextMatrix(.row, 3)
txt_qty.text = .TextMatrix(.row, 5)
combdj = .TextMatrix(.row, 4)
txt_total.text = .TextMatrix(.row, 6)
End With
txt_qty.SetFocus
txt_qty.tag = txt_qty.text
SendKeys "{Home}+{End}"
' CmdAct(1).Enabled = True
cmdSave.Enabled = False
CmdAct(2).Enabled = False
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -