📄
字号:
Case 2 '发生日期
.WglrGrid.TextMatrix(Int_GridRow, 4) = Trim(LrText(Jsqte).Text)
Case 3 '数量
.WglrGrid.TextMatrix(Int_GridRow, 5) = Val(LrText(Jsqte).Text)
Case 4 '单价
.WglrGrid.TextMatrix(Int_GridRow, 6) = Val(LrText(Jsqte).Text)
Case 5 '外币金额
.WglrGrid.TextMatrix(Int_GridRow, 10) = Trim(LrText(Jsqte).Text)
Case 6 '汇率
.WglrGrid.TextMatrix(Int_GridRow, 11) = Trim(LrText(Jsqte).Text)
Case 7 '部门
.WglrGrid.TextMatrix(Int_GridRow, 12) = Trim(LrText(Jsqte).Tag)
.WglrGrid.TextMatrix(Int_GridRow, 13) = Trim(LrText(Jsqte).Text)
Case 8 '客户
.WglrGrid.TextMatrix(Int_GridRow, 14) = Trim(LrText(Jsqte).Tag)
.WglrGrid.TextMatrix(Int_GridRow, 15) = Trim(LrText(Jsqte).Text)
Case 9 '个人
.WglrGrid.TextMatrix(Int_GridRow, 16) = Trim(LrText(Jsqte).Tag)
.WglrGrid.TextMatrix(Int_GridRow, 17) = Trim(LrText(Jsqte).Text)
Case 10 '项目
.WglrGrid.TextMatrix(Int_GridRow, 20) = Trim(LrText(Jsqte).Tag)
.WglrGrid.TextMatrix(Int_GridRow, 21) = Trim(LrText(Jsqte).Text)
Case 11 '项目数量
If Len(Trim(Lab_ItemMeasure)) <> 0 Then
.WglrGrid.TextMatrix(Int_GridRow, 22) = Trim(LrText(Jsqte).Text)
.WglrGrid.TextMatrix(Int_GridRow, 23) = Trim(Lab_ItemMeasure)
Else
.WglrGrid.TextMatrix(Int_GridRow, 22) = ""
.WglrGrid.TextMatrix(Int_GridRow, 23) = ""
End If
Case 12 '供应商
.WglrGrid.TextMatrix(Int_GridRow, 25) = Trim(LrText(Jsqte).Tag)
.WglrGrid.TextMatrix(Int_GridRow, 26) = Trim(LrText(Jsqte).Text)
Case 13 '经办人
.WglrGrid.TextMatrix(Int_GridRow, 24) = Trim(LrText(Jsqte).Text)
End Select
End If
Next Jsqte
End With
Bclrsj = True
End Function
Private Sub BcCommand_Click() '保 存
If Not Bclrsj Then
Exit Sub
End If
Unload Me
End Sub
Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '取消
'避免执行Click程序
Bln_Cancel = True
Call Sub_Cancel
End Sub
Private Sub QxCommand_Click() '取消
If Bln_Cancel Then
Bln_Cancel = False
Exit Sub
End If
Call Sub_Cancel
End Sub
Private Sub Sub_Cancel() '取消
'文本框加锁
For Jsqte = 0 To Max_Text_Index
TextValiJudgeLock(Jsqte) = True
Next Jsqte
Unload Me
End Sub
'************以下为文本框录入处理程序(固定不变部分)*************'
Private Sub Wbklrwbcl(Index As Integer) '文本框录入事后处理程序
'以下为依据实际情况自定义部分[
'在此填写文本框录入事后处理程序
']以上为依据实际情况自定义部分
End Sub
Private Sub LrText_Change(Index As Integer)
'屏蔽程序改变控制
If TextChangeLock Then
Exit Sub
End If
TextValiJudgeLock(Index) = False '打开有效性判断锁
'限制字段录入长度
TextChangeLock = True '加锁(防止执行Lrtext_Change)
Select Case Textint(Index, 1)
Case 8 '金额型
Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
Case 9 '数量型
Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
Case 10 '单价型
Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
Case Else '其他小数类型控制
If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
End If
End Select
TextChangeLock = False '解锁
End Sub
Private Sub LrText_GotFocus(Index As Integer) '文本框得到焦点,显示相应信息
Call TextShow(Index)
CurTextIndex = Index
LrText(Index).SelStart = Len(LrText(Index))
End Sub
Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) '字段按F2键提供帮助
Select Case KeyCode
Case vbKeyF2
Call Text_Help(Index)
End Select
End Sub
Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer) '文本框录入事中控制
Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub
Private Sub LrText_LostFocus(Index As Integer) '文本框失去焦点进行有效性判断及相应处理
If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
Call TextYxxpd(Index)
End If
End Sub
Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) '按钮提供帮助
Call Text_Help(Index)
End Sub
Private Sub Text_Help(Index As Integer) '录入字段帮助
If Not Textboolean(Index, 1) Then
Exit Sub
End If
TextValiJudgeLock(Index) = True
'先进行有效性判断
If Not TextYxxpd(CurTextIndex) Then
Exit Sub
End If
If Index = 10 Then '核算项目特殊处理
Xtcdcs = Trim(LrText(Index).Text)
Xtcdcsfz = Lab_ItemClass.Tag
XT_ItemHelp.Show 1
Else
Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
End If
If Len(Xtfhcs) <> 0 Then
If Textint(Index, 3) = 1 Then
LrText(Index).Text = Xtfhcsfz
LrText(Index).Tag = Xtfhcs
Else
LrText(Index).Text = Xtfhcs
LrText(Index).Tag = Xtfhcsfz
End If
End If
TextValiJudgeLock(Index) = False
LrText(Index).SetFocus
End Sub
Private Sub TextShow(Index As Integer) '文本框得到焦点,显示相应信息
'填写文本框得到焦点,进行相应信息处理程序
End Sub
Private Sub Wbkcsh() '录入文本框初始化
Dim Jsqte As Integer
'最大录入文本框索引值
Max_Text_Index = Textvar(1)
ReDim TextValiJudgeLock(Max_Text_Index)
For Jsqte = 0 To Max_Text_Index
If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
If Textboolean(Jsqte, 1) Then
If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
Load Ydcommand1(Jsqte)
End If
Ydcommand1(Jsqte).Visible = True
Ydcommand1(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
End If
TextChangeLock = True
LrText(Jsqte).Text = ""
LrText(Jsqte).Tag = ""
If Textint(Jsqte, 5) <> 0 Then
LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
End If
TextChangeLock = False
End If
TextValiJudgeLock(Jsqte) = True
Next Jsqte
End Sub
Private Function TextYxxpd(Index As Integer) As Boolean '文本框有效性判断
Dim SqlStr As String
Dim Findrec As ADODB.Recordset
If TextValiJudgeLock(Index) Then '文本框内容未曾改变不进行有效性判断
TextYxxpd = True
Exit Function
End If
If Trim(LrText(Index)) = "" Then
LrText(Index).Tag = ""
Call Wbklrwbcl(Index)
TextValiJudgeLock(Index) = True
TextYxxpd = True
Exit Function
End If
Select Case Textint(Index, 4)
Case 1 '编码型
SqlStr = Trim(Textstr(Index, 5))
SqlStr = Replace(SqlStr, "@", "'" + Trim(LrText(Index).Text) + "'")
Set Findrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Findrec.EOF Then
Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
LrText(Index).SetFocus
Exit Function
Else
Select Case Textint(Index, 3)
Case 0
If Len(Trim(Textstr(Index, 2))) <> 0 Then
LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
End If
If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
End If
Case 1
If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
End If
If Len(Trim(Textstr(Index, 2))) <> 0 Then
LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
End If
End Select
End If
Case 2 '日期型
If IsDate(LrText(Index).Text) Then
LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
End If
Else
Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
Call Xtxxts(Tsxx, 0, 1)
LrText(Index).SetFocus
Exit Function
End If
Case 3 '其他类型
Select Case Index
Case 10 '项目
SqlStr = "select * from Cwzz_item where ItemClassCode='" & Lab_ItemClass.Tag & "' and (ItemCode='" & Trim(LrText(10).Text) & "' or ItemName='" & Trim(LrText(10).Text) & "')"
Set Findrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
If Findrec.EOF Then
Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
LrText(Index).SetFocus
Exit Function
Else
Select Case Textint(Index, 3)
Case 0
If Len(Trim(Textstr(Index, 2))) <> 0 Then
LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
End If
If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
End If
Case 1
If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
End If
If Len(Trim(Textstr(Index, 2))) <> 0 Then
LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
End If
End Select
If Findrec.Fields("QuantityFlag") Then '数量核算显示单位
Lab_ItemMeasure = Trim(Findrec.Fields("Measure"))
Else
LrText(11).Text = ""
Lab_ItemMeasure = ""
End If
End If
End Select
End Select
TextValiJudgeLock(Index) = True
TextYxxpd = True
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -