📄 -
字号:
Combo_Kjqj1.AddItem Trim(.Fields("kjyear")) & "." & Mid(Trim(str(100 + .Fields("Period"))), 2, 2)
.MoveNext
Next i
.MoveLast
If .Fields("Period") <> 12 Then
Combo_Kjqj1.AddItem Trim(.Fields("kjyear")) & "." & Mid(Trim(str(100 + Val(.Fields("Period") + 1))), 2, 2)
End If
.MoveFirst
Combo_Kjqj1.Text = Trim(.Fields("kjyear")) & "." & Mid(Trim(str(100 + .Fields("Period"))), 2, 2)
Else
Combo_Kjqj1.AddItem Trim(Xtyear) & "." & "01"
Combo_Kjqj1.Text = Trim(Xtyear) & "." & "01"
End If
.Close
End With
Set Rec_Kjqj = Nothing
'以下为文本框处理程序
TextGroupCode = "KF_Batchtab_Find"
Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '读入文本框录入信息
Call Wbkcsh
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Me.Hide
End Sub
Private Sub QdCommand_Click() '确 定
'录入条件有效性判断
If Not Lrtjyxxpd Then
Exit Sub
End If
Me.Hide
'激活查询过程
KF_FrmMateBatch.Timer1.Enabled = True
End Sub
Private Sub QxCommand_Click() '取消
Me.Hide
End Sub
Private Function Lrtjyxxpd() As Boolean '用户录入条件有效性判断
Dim jsqte As Integer
Lrtjyxxpd = False
'对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
For jsqte = 0 To Max_Text_Index
If Textint(Index, 9) = 0 Or Textint(Index, 9) = 2 Then
If Not TextYxxpd(jsqte) Then
Exit Function
End If
End If
Next jsqte
'[>>以下为依据实际情况自定义部分
If Combo_Kjqj1.Text > Combo_Kjqj2.Text And Combo_Kjqj2.Text <> "" Then
tsxx = "日期范围应由小到大!"
Call Xtxxts(tsxx, 0, 4)
Combo_Kjqj1.SetFocus
Exit Function
End If
'<<]以上为依据实际情况自定义部分
Lrtjyxxpd = True
End Function
Private Sub Cmd_Clear_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '将用户输入条件全部清除
'清除文本框
For jsqte = 0 To Max_Text_Index
LrText(jsqte).Tag = ""
LrText(jsqte).Text = ""
Next jsqte
Label2 = ""
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)
Call TextChangeLimit(LrText(Index), Textint(Index, 1)) '去掉无效字符
Select Case Textint(Index, 1)
Case 8, 11 '金额型
Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
Case 9, 12 '数量型
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
'调用帮助
If Textint(Index, 2) <> 1 Then
If Index = 0 Then
strHlpR = FunHlpR(Trim(Textstr(Index, 4)), "czybm", Xtczybm)
Else
strHlpR = FunHlpR(Trim(Textstr(Index, 4)), "whcode", Trim(LrText(0).Tag))
End If
End If
Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
'根据设置选择显示编码和名称,并进行存储
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
If Index = 2 Then
Label2 = LrText(Index).Tag
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
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))
If Index = 0 Then
Sqlstr = "select * from KF_V_WhLimit where czybm='" & Xtczybm & "' and (whname='" & Trim(LrText(Index).Text) & "' or whcode='" & Trim(LrText(Index).Text) & "')"
Else
Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
End If
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 Index = 2 Then
Label2 = LrText(Index).Tag
End If
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 '其它类型
End Select
TextValiJudgeLock(Index) = True
TextYxxpd = True
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -