📄
字号:
Case "货币型"
.Fields("Datatype") = 4
Case "日期型"
.Fields("Datatype") = 5
End Select
.Fields("FieldLength") = Val(LrText(1).Text)
.Fields("IntLength") = Val(LrText(2).Text)
.Fields("DeciLength") = Val(LrText(3).Text)
.Fields("FieldState") = True
.Update
End With
End If
rstemp.Close
Set rstemp = Nothing
Call Sqlcd
Cw_DataEnvi.DataConnect.Execute (Sqlstr) '追加资产卡片表
Cw_DataEnvi.DataConnect.Execute (SqlStr1) '追加资产卡片附表
'取得自定义数量
Set rstemp = New ADODB.Recordset
rstemp.Open "select count(*) as zdsl from gdzc_custom where FieldState='1' ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not rstemp.EOF Then
i = rstemp.Fields("zdsl")
End If
rstemp.Close
Set rstem = Nothing
'限制文本框录入格式
Set rstemp = New ADODB.Recordset
rstemp.Open "SELECT * From Xt_text_input WHERE system_code = 'gdzc' AND text_group_code = 'gdzc_cardjbcz' and text_name='自定义" & i & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With rstemp
If Not .EOF Then
Select Case Com_DataType.Text
Case "字符型"
.Fields("Text_data_type") = 0
.Fields("Text_Length") = Val(LrText(1).Text)
.Fields("judge_type") = 0
Case "整数型"
.Fields("Text_data_type") = 4
.Fields("text_length") = 5
.Fields("judge_type") = 0
Case "小数型"
.Fields("Text_data_type") = 6
.Fields("judge_type") = 0
.Fields("text_length") = Val(LrText(2).Text) + Val(LrText(3).Text) + 1
Case "货币型"
.Fields("Text_data_type") = 8
.Fields("judge_type") = 0
Case "日期型"
.Fields("Text_data_type") = 7
.Fields("judge_type") = 2
.Fields("text_length") = 10
End Select
.Update
End If
End With
rstemp.Close
Set rstemp = Nothing
Tsxx = "保存完毕!"
Call Xtxxts(Tsxx, 0, 4)
Call Cshlrxx(1)
Call Cxnrtcwg
Cw_DataEnvi.DataConnect.CommitTrans
Exit Sub
End If
If Lrzt = 2 Then '修改
Set rstemp = New ADODB.Recordset
rstemp.Open "select * from gdzc_custom where fieldCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not rstemp.EOF Then
With rstemp
CodeTemp = .Fields("FieldCode")
.Fields("FieldName") = Trim(LrText(0).Text)
Select Case Com_DataType.Text
Case "字符型"
.Fields("Datatype") = 1
Case "整数型"
.Fields("Datatype") = 2
Case "小数型"
.Fields("Datatype") = 3
Case "货币型"
.Fields("Datatype") = 4
Case "日期型"
.Fields("Datatype") = 5
End Select
.Fields("FieldLength") = Val(LrText(1).Text)
.Fields("IntLength") = Val(LrText(2).Text)
.Fields("DeciLength") = Val(LrText(3).Text)
.Fields("FieldState") = True
.Update
End With
End If
Cw_DataEnvi.DataConnect.Execute ("alter table Gdzc_card drop column " & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))))
Cw_DataEnvi.DataConnect.Execute ("alter table Gdzc_cardtemp drop column " & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))))
Call Sqlcd
Cw_DataEnvi.DataConnect.Execute (Sqlstr)
Cw_DataEnvi.DataConnect.Execute (SqlStr1)
Set rstemp = New ADODB.Recordset
rstemp.Open "select count(*) as zdsl from gdzc_custom where FieldState='1'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not rstemp.EOF Then
i = rstemp.Fields("zdsl")
End If
rstemp.Close
Set rstem = Nothing
Set rstemp = New ADODB.Recordset
rstemp.Open "SELECT * From Xt_text_input WHERE system_code = 'gdzc' AND text_group_code = 'gdzc_cardjbcz' and text_name='自定义" & i & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With rstemp
If Not .EOF Then
Select Case Com_DataType.Text
Case "字符型"
.Fields("Text_data_type") = 0
.Fields("Text_Length") = Val(LrText(1).Text)
.Fields("judge_type") = 0
Case "整数型"
.Fields("Text_data_type") = 4
.Fields("text_length") = 5
.Fields("judge_type") = 0
Case "小数型"
.Fields("Text_data_type") = 6
.Fields("judge_type") = 0
Case "货币型"
.Fields("Text_data_type") = 8
.Fields("judge_type") = 0
Case "日期型"
.Fields("Text_data_type") = 7
.Fields("judge_type") = 2
.Fields("text_length") = 10
End Select
.Fields("Text_Length") = Val(LrText(1).Text)
.Update
End If
End With
rstemp.Close
Set rstemp = Nothing
Tsxx = "保存完毕!"
Call Xtxxts(Tsxx, 0, 4)
Call Cancel
Call Cxnrtcwg
Cw_DataEnvi.DataConnect.CommitTrans
Exit Sub
End If
Cwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End Sub
Private Sub QxCommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '取消
'避免执行Click程序
Bln_Cancel = True
Call Cancel
End Sub
Private Sub QxCommand_Click() '取消
If Bln_Cancel Then
Bln_Cancel = False
Exit Sub
End If
Call Cancel
End Sub
Private Sub Cancel() '取消
'文本框加锁
For Jsqte = 0 To Max_Text_Index
TextValiJudgeLock(Jsqte) = True
Next Jsqte
Call Toolfbjzt
End Sub
Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long) '网格列发生移动时自动交换网格索引信息
FnBln_RefreshArray Col, Position, GridStr(), GridInf()
End Sub
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button) '表格格式设置(通用)
Select Case Button.Key
Case "bcgs" '保存表格格式
Call Bcwggs(CzxsGrid, GridCode, GridStr())
Case "hfmrgs" '恢复默认格式
Call Hfmrgs(CzxsGrid, GridCode, GridStr())
Case "szxsxm" '设置显示项目
Call Szxsxm(CzxsGrid, GridCode)
End Select
End Sub
Private Sub bbyl(bbylte As Boolean) '报表打印预览
Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
Bbxbtgs = 1 '报 表 小 标 题 行 数
Bbbwhgs = 0 '报 表 表 尾 行 数
ReDim Bbxbt(1 To Bbxbtgs)
ReDim bbxbtzzxs(1 To Bbxbtgs)
If Bbbwhgs <> 0 Then
ReDim Bbbwh(1 To Bbbwhgs)
ReDim Bbbwhzzxs(1 To Bbbwhgs)
End If
Bbzbt = ReportTitle
Bbxbt(1) = " "
bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
Call Scyxsjb(CzxsGrid) '生成报表数据
Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
If Not bbylte Then
Unload DY_Tybbyldy
End If
End Sub
'*******************以下区域为编写自定义过程区域**********************
'为零时清空单元格
Function Txt_Clear()
Dim Row_Integer, Col_Integer As Integer '行数和列数变量
For Row_Integer = CzxsGrid.FixedRows To CzxsGrid.Rows - 1
For Col_Integer = 3 To 5
If Format(Val(CzxsGrid.TextMatrix(Row_Integer, Col_Integer)), "0.00") = 0# Then
CzxsGrid.TextMatrix(Row_Integer, Col_Integer) = ""
End If
Next Col_Integer
Next Row_Integer
End Function
'*******************以上区域为编写自定义过程区域**********************
'************以下为文本框录入处理程序(固定不变部分)*************'
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, 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 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
'调用帮助
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
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -