📄
字号:
If rsTckd![cPAccID] = Edityhzh(1).Text Then
ye = rsTckd![mMoney]
End If
End If
err2: ye = ye + Gethqzhye(Edityhzh(1).Text)
If ye < CDbl(Editje(0).Text) Then
Beep
If HqzhRedcx(Edityhzh(1).Text, ye - CDbl(Editje(0).Text)) Then
SetTxtFocus Editje(0)
Exit Function
End If
End If
End If
Ckdquit = True
End Function
''''''获取最大单据业务编号
'''''Private Function Getmaxbh()
''''' Dim rsTemp As New UfRecordset, i As Long
''''' Set rsTemp = dbsZJ.OpenRecordset("FD_settacc", dbOpenTable)
''''' With rsTemp
''''' .Index = "PrimaryKey"
''''' FindFirst rsTckd, "cSetID <= '" + "15" + "'"
''''' If .EOF Then
''''' Getmaxbh = "00000001"
''''' Else
''''' Getmaxbh = Right(str(100000001 + Right(![csetid], 8)), 8)
''''' End If
''''' If Getmaxbh = "00000000" Then
''''' For i = 1 To 99999998
''''' Getmaxbh = Right(str(100000000 + i), 8)
''''' .oSeek "=", "14" & Getmaxbh
''''' If .EOF Then
''''' Exit Sub
''''' End If
''''' Next
''''' End If
''''' .Close
''''' End With
'''''End Sub
'增加新单据
Private Sub Ckdappe()
Textqk
Editbh.Text = oV.getMaxID("14")
IsNew = True
End Sub
Private Sub CkdSave()
On Error Resume Next
Dim sav_js As Integer
If isSave Then Exit Sub
sav_js = 0
cf: CkdSave1
'cuidong 2001.08.24
'----------------------------
' If Not isSave Then
' sav_js = sav_js + 1
' If sav_js < 1000 Then GoTo cf
' Beep
' MsgBox "其他工作站正在保存，请过一会儿再试！", vbOKOnly + vbInformation, zjGl_Name
' End If
'----------------------------
End Sub
'存盘
Private Sub CkdSave1()
Dim newmaxbh As String, rsTemp As New UfRecordset, oldbh As String
Dim sID As String
On Error GoTo er1
newmaxbh = "14" & Editbh.Text
BillSaveLock "14" 'cuidong 2001.08.28
If IsNew Then
'''' Set rsTemp = dbsZJ.OpenRecordset("FD_Settacc", dbOpenTable)
'''' With rsTemp
'''' .Index = "PrimaryKey"
'''' .oSeek "=", newmaxbh
'''' If Not .eof Then
'''' .oSeek "<=", "15"
'''' newmaxbh = "14" & Right(str(100000001 + Right(![csetid], 8)), 8)
'''' Editbh.Text = Right(newmaxbh, 8)
'''' End If
'''' .Close
'''' End With
'''' rsTckd.AddNew
'cuidong 2001.08.23
'-----------------------------
' If oV.IDExists(newmaxbh) Then newmaxbh = oV.getMaxID("14") 'cuidong 2001.08.22
If oV.IDExists(newmaxbh) Then
sID = "14" & oV.getMaxID("14")
'MsgBox "编号‘" & Right$(newmaxbh, 8) & "’已存在，系统将使用新编号‘" & Right$(sID, 8) & "’"
newmaxbh = sID
Editbh.Text = Right$(sID, 8)
End If
'-----------------------------
Else
Label1(19).Caption = IIf(IsNull(rsTckd![cCheckCode]), "", rsTckd![cCheckCode])
If Label1(19).Caption <> "" Then
Beep
MsgBox "对不起，这张单子已被审核过！", vbOKOnly + vbInformation, zjGl_Name
Carddata
isSave = True
Exit Sub
End If
'''' rsTckd.edit
End If
Savdata newmaxbh
BillSaveUnLock "14" 'cuidong 2001.08.28
Exit Sub
er1:
'cuidong 2001.08.24
'----------------------
' If Err.Number = -2147220991 Then '关键字冲突（并发） 'cuidong 2001.01.12
' MsgBox "其它用户正使用相同的业务编号来保存单据，请您重新输入。", vbCritical, zjGl_Name 'cuidong 2001.01.12
'
' ElseIf Err.Number = 3260 Then
'
' ElseIf Err.Number = 3167 Then
Select Case Err.Number
Case 3167
'----------------------
rsTckd.AddNew
IsNew = True
Savdata newmaxbh
Case Err.Number = 3022
Savdata "14" & oV.getMaxID("14")
End Select
BillSaveUnLock "14" 'cuidong 2001.08.28
End Sub
'窗体赋值
Private Sub Carddata()
With rsTckd
If Not .EOF Then
Frtin = True
Textjsfs.Text = Jsfscton(![icen_id], True)
Editrq.Text = Format(![dbill_date], "yyyy-mm-dd")
Editbh.Text = Right(![cSetid], 8)
Edityhzh(0).Text = ![cGAccID]
Edityhmc(0).Text = Zhbhtodwmc(Edityhzh(0).Text)
Edityhzh(1).Text = ![cPAccID]
Edityhmc(1).Text = Zhbhtodwmc(Edityhzh(1).Text)
Textbb.Text = Wgetwbb(Edityhzh(0).Text)
Editje(1).Text = ![nFrat]
Editje(0).Text = Format(![mMoney], "#0.00")
Textje.Text = Format(![mMoney_F], "#0.00")
Editzy(0).Text = IIf(IsNull(![cDigest]), "", ![cDigest])
Editzy(1).Text = IIf(IsNull(![center_name]), "", ![center_name])
Editzy(2).Text = IIf(IsNull(![cbank_name]), "", ![cbank_name])
Editzy(3).Text = IIf(IsNull(![cbank_code]), "", ![cbank_code])
Editzy(4).Text = IIf(IsNull(![crun_name]), "", ![crun_name])
Editzy(5).Text = IIf(IsNull(![cset_name]), "", ![cset_name])
Label1(19).Caption = IIf(IsNull(![cCheckCode]), "", ![cCheckCode])
Label1(21).Caption = IIf(IsNull(![cBookCode]), "", ![cBookCode])
Label1(23).Caption = ![cBillCode]
Option1(0).Value = IIf(![igp_flag] = 0, True, False)
Option1(1).Value = IIf(![igp_flag] = 0, False, True)
Frtin = False
Else
Textqk
End If
End With
isSave = True
IsNew = False
End Sub
'表赋值
Private Sub Savdata(bh As String)
With oVd
.Add "icen_id", Jsfscton(Textjsfs.Text, False)
.Add "dbill_date", Editrq.Text
.Add "cSetID", bh
.Add "cGAccID", Edityhzh(0).Text
.Add "cPAccID", Edityhzh(1).Text
.Add "nfrat", CDbl(Editje(1).Text)
.Add "mMoney", CDbl(Editje(0).Text)
.Add "mmoney_f", CDbl(Textje.Text)
.Add "igp_flag", IIf(Option1(0).Value = True, 0, 1)
.Add "cdigest", IIf(Editzy(0).Text = "", Null, Editzy(0).Text)
.Add "center_name", IIf(Editzy(1).Text = "", Null, Editzy(1).Text)
.Add "cbank_name", IIf(Editzy(2).Text = "", Null, Editzy(2).Text)
.Add "cbank_code", IIf(Editzy(3).Text = "", Null, Editzy(3).Text)
.Add "crun_name", IIf(Editzy(4).Text = "", Null, Editzy(4).Text)
.Add "cset_name", IIf(Editzy(5).Text = "", Null, Editzy(5).Text)
.Add "cBillCode", zjLogInfo.cUserName
If IsNew Then
If Not oV.Add(oVd) Then Err = 0: Exit Sub
Else
If Not oV.edit(oVd, bh) Then Err = 0: Exit Sub
End If
'' .Update
''' rsTckd.Requery
''' .Find "cSetID='14" & Editbh & "'"
End With
isSave = True
IsNew = False
Label1(23).Caption = zjLogInfo.cUserName
End Sub
' 根据单据属性，置工具栏按钮、参照属性
Private Sub ckdbutt()
Dim czk As Boolean
If Label1(19).Caption = "" Then
If rsTckd.EOF And (Not IsNew) Then
czk = False
isFh = False
Else
czk = True
isFh = False
If isSave Then
If oV.hasMadePZ("14" & Editbh.Text) Then
isFh = True
End If
End If
End If
but_ctrl Not isFh, czk
Else
isFh = True
czk = True
but_ctrl False
End If
Textjsfs.Locked = isFh
Editbh.Locked = Not IsNew
Editrq.Locked = isFh
Edityhmc(0).Locked = isFh
Edityhzh(0).Locked = isFh
Edityhmc(1).Locked = isFh
Edityhzh(1).Locked = isFh
Editje(0).Locked = isFh
Editje(1).Locked = isFh Or Textbb.Text = ZjAccInfo.zjStandExch
Option1(0).Enabled = Not isFh And czk
Option1(1).Enabled = Not isFh And czk
Editzy(0).Locked = isFh
Editzy(1).Locked = isFh
Editzy(2).Locked = isFh
Editzy(3).Locked = isFh
Editzy(4).Locked = isFh
Editzy(5).Locked = isFh
''''' Pagezt Tlbckd, rsTckd, IsNew Or Not isSave
Frtin = True
If Not IsNew And isSave Then
On Error Resume Next
Editbh.Visible = False
If Editbh.Text = "" Then
Combo1.Clear
Else
Combo1.Text = Editbh.Text
If Err.Number = 383 Then
Combo1.AddItem Editbh.Text
Combo1.Text = Editbh.Text
End If
End If
Combo1.Visible = True
Else
Editbh.Visible = True
If isSave And IsNew Then
Textjsfs.SetFocus
End If
Combo1.Visible = False
End If
Frtin = False
oV.setPageState Tlbckd, Combo1, IsNew Or Not isSave
End Sub
Private Sub but_ctrl(Fhbz As Boolean, Optional czk As Boolean)
If Fhbz Then
Dim tbn As Boolean
Emptyckd czk, czk
tbn = (Not rsTckd.EOF) And isSave And (Not IsNew)
Tlbckd.Buttons("Preview").Enabled = tbn
Tlbckd.Buttons("Print").Enabled = tbn
Tlbckd.Buttons("Dataout").Enabled = tbn
Tlbckd.Buttons("SaveRecord").Enabled = Not isSave
Tlbckd.Buttons("DeleteRecord").Enabled = (Not rsTckd.EOF) Or IsNew
Tlbckd.Buttons("CopyRecord").Enabled = tbn Or IsNew And Djcopy(0) <> ""
If Checkqx Then
Tlbckd.Buttons("Check").Enabled = tbn
Tlbckd.Buttons("CheckCancel").Enabled = tbn
End If
Tlbckd.Buttons("PingZheng").Enabled = tbn
Else
Emptyckd True, False
Tlbckd.Buttons("Preview").Enabled = True
Tlbckd.Buttons("Print").Enabled = True
Tlbckd.Buttons("Dataout").Enabled = True
Tlbckd.Buttons("SaveRecord").Enabled = False
Tlbckd.Buttons("DeleteRecord").Enabled = False
Tlbckd.Buttons("CopyRecord").Enabled = True
If Checkqx Then
Tlbckd.Buttons("Check").Enabled = True
Tlbckd.Buttons("CheckCancel").Enabled = True
End If
Tlbckd.Buttons("PingZheng").Enabled = True
End If
End Sub
' 置所有可获得焦点控件属性
Private Sub Emptyckd(fsk As Boolean, cmdfs As Boolean)
Option1(0).Enabled = fsk
Option1(1).Enabled = fsk
Textjsfs.Enabled = fsk
Editbh.Enabled = fsk
Editrq.Enabled = fsk
Edityhmc(0).Enabled = fsk
Edityhzh(0).Enabled = fsk
Edityhmc(1).Enabled = fsk
Edityhzh(1).Enabled = fsk
Editje(0).Enabled = fsk
Editje(1).Enabled = fsk
Editzy(0).Enabled = fsk
Editzy(1).Enabled = fsk
Editzy(2).Enabled = fsk
Editzy(3).Enabled = fsk
Editzy(4).Enabled = fsk
Editzy(5).Enabled = fsk
refyhmc(0).Enabled = cmdfs
refyhmc(1).Enabled = cmdfs
Refyhzh(0).Enabled = cmdfs
Refyhzh(1).Enabled = cmdfs
cmdjsfs.Enabled = cmdfs
cmdrq.Enabled = cmdfs
End Sub
'初始化TEXT
Private Sub Textqk()
Frtin = True
Editrq.Text = Format(zjLogInfo.curDate, "yyyy-mm-dd") '日期赋初始值
Textjsfs.Text = ""
Editbh.Text = ""
Edityhmc(0).Text = ""
Edityhzh(0).Text = ""
Edityhmc(1).Text = ""
Edityhzh(1).Text = ""
Textbb.Text = ""
Editje(0).Text = ""
Editje(1).Text = ""
Textje.Text = ""
Editzy(0).Text = ""
Editzy(1).Text = ""
Editzy(2).Text = ""
Editzy(3).Text = ""
Editzy(4).Text = ""
Editzy(5).Text = ""
Label1(19).Caption = ""
Label1(21).Caption = ""
Label1(23).Caption = ""
isSave = True
IsNew = False
Frtin = False
End Sub
'删除单据
Private Sub Ckddele()
On Error Resume Next
If Not IsNew And IsNull(rsTckd!cCheckCode) Then
''' rsTckd.Delete
oV.Delete rsTckd.Fields!cSetid
'''' rsTckd.Requery
End If
isSave = True
IsNew = False
End Sub
'翻页
Private Sub Getckd(zt As Integer, bhk As String)
On Error GoTo reqer3
If rsTckd Is Nothing Then
reqer3: Set rsTckd = oV.getUnBookRst
Else
rsTckd.Requery
End If
With rsTckd
If .EOF Then
Textqk
Exit Sub
End If
.MoveLast
End With
Select Case zt
Case Is = 1
rsTckd.MoveFirst
Case Is = 2
With rsTckd
FindFirst rsTckd, "csetid >= '14" & bhk & "'"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -