企业管理

开发平台：

Visual Basic

：源码内容

VERSION 5.00
Object = "{DD44C0E7-B2CF-11D1-8DD3-444553540000}#1.0#0"; "cell32.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Frm_edit
Caption = "Form1"
ClientHeight = 6510
ClientLeft = 60
ClientTop = 345
ClientWidth = 8160
Icon = "编辑窗口.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6510
ScaleWidth = 8160
WindowState = 2 'Maximized
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5310
Top = 5790
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin CELLLib.Cell Cell1
Height = 4935
Left = 0
TabIndex = 0
Top = 360
Width = 7755
_Version = 65536
_ExtentX = 13679
_ExtentY = 8705
_StockProps = 0
End
End
Attribute VB_Name = "Frm_edit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************
'* 模块名称 :编辑窗口
'* 功能描述 :
'* 程序员姓名 :奚俊峰
'* 最后修改人 :奚俊峰
'* 最后修改时间:2002/01/21
'***********************************************
Option Explicit
Public ml_col As Long '当前列
Public ml_row As Long '当前行
Public mcls_new_report As cls_new_report '新建报表类
Public mcls_new_report_model As cls_new_report_model '新建报表模板类
Public mcls_open_report As cls_open_report '打开报表类
Public mcls_open_report_model As cls_open_report_model '打开报表模板类
Public ml_edit_lx As Integer '当前编辑的表格的类型
'1?打开报表
'2?打开报表模板
'3?打开文件
'4?新建报表
'5?新建报表模板
'6?新建文件
'7?新建汇总表文件
Public ms_filename As String '当前打开或新建的文件名称
Dim mai_parmtype_ncs() As Integer
Dim mai_parmdefault_ncs() As Integer
Dim mai_parmtype_qms() As Integer
Dim mai_parmdefault_qms() As Integer
Dim i As Integer, j As Integer
Dim ms_save_time As String
'-------------------------------------------------------------------
'
'新函数增加说明:
'
'(1)添加该函数的帮助说明
' 在 :Private Function mf_addfunctioin
' 格式:参见财务函数的格式
'
'(2)添加函数执行过程的处理
' 在 :Private Sub Cell1_OnExecuteUserFunc
' 格式:参见财务函数执行过程的处理
' 加: Case "YourFunctionName"
' 函数过程处理
'
'-------------------------------------------------------------------
'增加新函数
Private Function mf_addfunction()
Dim rt As Boolean
Dim ls_hssm As String
'1.年初余额
ls_hssm = "函数名称:" & vbCrLf & _
" JE_NCYE ----年初余额" & vbCrLf & _
"函数格式:" & vbCrLf & _
" JE_NCYE(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_ncs(5) As Integer
ReDim mai_parmdefault_ncs(5) As Integer
For i = 0 To 4
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "JE_NCYE", 4, 5, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'2.期初余额
ls_hssm = "函数名称:" & vbCrLf & _
" JE_QCYE ----期初余额" & vbCrLf & _
"函数格式:" & vbCrLf & _
" JE_QCYE(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "JE_QCYE", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'3.期末余额
ls_hssm = "函数名称:" & vbCrLf & _
" JE_QMYE ----期末余额" & vbCrLf & _
"函数格式:" & vbCrLf & _
" JE_QMYE(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "JE_QMYE", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'4.本期借方发生额
ls_hssm = "函数名称:" & vbCrLf & _
" JE_BQJFS ----本期借方发生额" & vbCrLf & _
"函数格式:" & vbCrLf & _
" JE_BQJFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "JE_BQJFS", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'5.本期贷方发生额
ls_hssm = "函数名称:" & vbCrLf & _
" JE_BQDFS ----本期贷方发生额" & vbCrLf & _
"函数格式:" & vbCrLf & _
" JE_BQDFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "JE_BQDFS", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'6.累计借方发生额
ls_hssm = "函数名称:" & vbCrLf & _
" JE_LJJFS ----累计借方发生额" & vbCrLf & _
"函数格式:" & vbCrLf & _
" JE_LJJFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "JE_LJJFS", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'7.累计贷方发生额
ls_hssm = "函数名称:" & vbCrLf & _
" JE_LJDFS ----累计贷方发生额" & vbCrLf & _
"函数格式:" & vbCrLf & _
" JE_LJDFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "JE_LJDFS", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'8.年净发生额
ls_hssm = "函数名称:" & vbCrLf & _
" JE_NJFSE ----年净发生额" & vbCrLf & _
"函数格式:" & vbCrLf & _
" JE_NJFSE(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "JE_NJFSE", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'9.月净发生额
ls_hssm = "函数名称:" & vbCrLf & _
" JE_YJFSE ----月净发生额" & vbCrLf & _
"函数格式:" & vbCrLf & _
" JE_YJFSE(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "JE_YJFSE", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'1.年初数量
ls_hssm = "函数名称:" & vbCrLf & _
" SL_NC ----年初数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SL_NC(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_ncs(5) As Integer
ReDim mai_parmdefault_ncs(5) As Integer
For i = 0 To 4
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "SL_NC", 4, 5, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'2.期初数量
ls_hssm = "函数名称:" & vbCrLf & _
" SL_QC ----期初数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SL_QC(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "SL_QC", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'3.期末数量
ls_hssm = "函数名称:" & vbCrLf & _
" SL_QM ----期末数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SL_QM(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "SL_QM", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'4.本期借方发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" SL_BQJF ----本期借方发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SL_BQJF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "SL_BQJF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'5.本期贷方发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" SL_BQDF ----本期贷方发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SL_BQDFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "SL_BQDF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'6.累计借方发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" SL_LJJF ----累计借方发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SL_LJJF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "SL_LJJF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'7.累计贷方发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" SL_LJDF ----累计贷方发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SL_LJDF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "SL_LJDF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'4.项目本期借方发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" XMSL_BQJF ----项目本期借方发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" XMSL_BQJF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,不能为空,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上,可以为空?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "XMSL_BQJF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'5.项目本期贷方发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" XMSL_BQDF ----项目本期贷方发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" XMSL_BQDF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,不能为空,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上,可以为空?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "XMSL_BQDF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'6.项目累计借方发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" XMSL_LJJF ----项目累计借方发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" XMSL_LJJF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,不能为空,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上,可以为空?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "XMSL_LJJF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'7.项目累计贷方发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" XMSL_LJDF ----项目累计贷方发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" XMSL_LJDF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,不能为空,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上,可以为空?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "XMSL_LJDF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'8.年净发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" SL_NJFS ----年净发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SL_NJFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "SL_NJFS", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'9.月净发生数量
ls_hssm = "函数名称:" & vbCrLf & _
" SL_YJFS ----月净发生数量" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SL_YJFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "SL_YJFS", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'1.年初外币
ls_hssm = "函数名称:" & vbCrLf & _
" WB_NC ----年初外币" & vbCrLf & _
"函数格式:" & vbCrLf & _
" WB_NC(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_ncs(5) As Integer
ReDim mai_parmdefault_ncs(5) As Integer
For i = 0 To 4
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "WB_NC", 4, 5, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'2.期初外币
ls_hssm = "函数名称:" & vbCrLf & _
" WB_QC ----期初外币" & vbCrLf & _
"函数格式:" & vbCrLf & _
" WB_QC(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "WB_QC", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'3.期末外币
ls_hssm = "函数名称:" & vbCrLf & _
" WB_QM ----期末外币" & vbCrLf & _
"函数格式:" & vbCrLf & _
" WB_QM(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "WB_QM", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'4.本期借方发生外币
ls_hssm = "函数名称:" & vbCrLf & _
" WB_BQJF ----本期借方发生外币" & vbCrLf & _
"函数格式:" & vbCrLf & _
" WB_BQJF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "WB_BQJF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'5.本期贷方发生外币
ls_hssm = "函数名称:" & vbCrLf & _
" WB_BQDF ----本期贷方发生外币" & vbCrLf & _
"函数格式:" & vbCrLf & _
" WB_BQDFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "WB_BQDF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'6.累计借方发生外币
ls_hssm = "函数名称:" & vbCrLf & _
" WB_LJJF ----累计借方发生外币" & vbCrLf & _
"函数格式:" & vbCrLf & _
" WB_LJJF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "WB_LJJF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'7.累计贷方发生外币
ls_hssm = "函数名称:" & vbCrLf & _
" WB_LJDF ----累计贷方发生外币" & vbCrLf & _
"函数格式:" & vbCrLf & _
" WB_LJDF(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "WB_LJDF", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'8.年净发生外币
ls_hssm = "函数名称:" & vbCrLf & _
" WB_NJFS ----年净发生外币" & vbCrLf & _
"函数格式:" & vbCrLf & _
" WB_NJFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "WB_NJFS", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'9.月净发生外币
ls_hssm = "函数名称:" & vbCrLf & _
" WB_YJFS ----月净发生外币" & vbCrLf & _
"函数格式:" & vbCrLf & _
" WB_YJFS(""科目编码"",""年"",""月"",""辅助项1"",""辅助项2"")" & vbCrLf & _
"参数表示:" & vbCrLf & _
" 年:可以输入“本年”?“去年”或任意数值?" & vbCrLf & _
" 月:可以输入“本月”?“上月”或1--12任意数值?" & vbCrLf & _
" 辅助项1:可以输入“标识+辅助项码”,其中标识为: P-职员 D-部门 C-往来客户 S-供应商 I-项目分类 J-项目?" & _
"例如:P0500表示编码为0500的职员?" & vbCrLf & _
" 辅助项2:同上?区别:只有在辅助项1有内容时才起作用,增加一个标识“*”,当输入“*”时,表示取辅助项1的汇总数?" & _
"例如:辅助项1为“财务部”,辅助项2为“*”,表示取财务部所有人员的费用总和?"
ReDim mai_parmtype_qms(5) As Integer
ReDim mai_parmdefault_qms(5) As Integer
For i = 0 To 4
mai_parmtype_qms(i) = 1
mai_parmdefault_qms(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("财务总帐函数", "WB_YJFS", 4, 5, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'10.年
ls_hssm = "函数名称:" & vbCrLf & _
" DATE_Y ----年" & vbCrLf & _
"函数格式:" & vbCrLf & _
" DATE_Y(""年"")" & vbCrLf & _
" 年可以输入“2000”?“1999”或任意数值?"
ReDim mai_parmtype_qms(1) As Integer
ReDim mai_parmdefault_qms(1) As Integer
mai_parmtype_qms(0) = 1
mai_parmdefault_qms(0) = Year(Xtrq)
rt = Cell1.DoAddUserFunctionEx("系统基本函数", "DATE_Y", 4, 1, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'11.月
ls_hssm = "函数名称:" & vbCrLf & _
" DATE_M----月" & vbCrLf & _
"函数格式:" & vbCrLf & _
" DATE_M(""月"")" & vbCrLf & _
" 月可以输入“1”?“2”?......?“12”?"
ReDim mai_parmtype_qms(1) As Integer
ReDim mai_parmdefault_qms(1) As Integer
mai_parmtype_qms(0) = 1
mai_parmdefault_qms(0) = Month(Xtrq)
rt = Cell1.DoAddUserFunctionEx("系统基本函数", "DATE_M", 4, 1, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'12.日
ls_hssm = "函数名称:" & vbCrLf & _
" DATE_D----日" & vbCrLf & _
"函数格式:" & vbCrLf & _
" DATE_D(""日"")" & vbCrLf & _
" 日可以输入“1”?“2”?“3”?.....等但不能大于当前月末的日?"
ReDim mai_parmtype_qms(1) As Integer
ReDim mai_parmdefault_qms(1) As Integer
mai_parmtype_qms(0) = 1
mai_parmdefault_qms(0) = Day(Xtrq)
rt = Cell1.DoAddUserFunctionEx("系统基本函数", "DATE_D", 4, 1, mai_parmtype_qms(0), mai_parmdefault_qms(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'13.从第X页表
ls_hssm = "函数名称:" & vbCrLf & _
" GETDATAFPAGE----从第X页表的第I列?第J行取数据" & vbCrLf & _
"函数格式:" & vbCrLf & _
" GETDATAFPAGE(""页码"",""行号"",""列号"")" & vbCrLf & _
" 页码可以输入“1”到当前页表数 " & vbCrLf & _
" 行号可以输入“1”到最大行数" & vbCrLf & _
" 列号可以输入“1”到最大列数? "
ReDim mai_parmtype_ncs(3) As Integer
ReDim mai_parmdefault_ncs(3) As Integer
mai_parmtype_ncs(0) = 1
mai_parmtype_ncs(1) = 1
mai_parmtype_ncs(2) = 1
mai_parmdefault_ncs(0) = 1
mai_parmdefault_ncs(1) = 1
mai_parmdefault_ncs(2) = 1
rt = Cell1.DoAddUserFunctionEx("系统基本函数", "GETDATAFPAGE", 4, 3, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'14.编制单位
ls_hssm = "函数名称:" & vbCrLf & _
" ENTERPRISE----编制单位" & vbCrLf & _
"函数格式:" & vbCrLf & _
" ENTERPRISE()" & vbCrLf & _
" 不许任何参数? "
ReDim mai_parmtype_ncs(1) As Integer
ReDim mai_parmdefault_ncs(1) As Integer
mai_parmtype_ncs(0) = 1
mai_parmdefault_ncs(0) = 1
rt = Cell1.DoAddUserFunctionEx("系统基本函数", "ENTERPRISE", 4, 0, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'14.系统操作员
ls_hssm = "函数名称:" & vbCrLf & _
" OPERATOR----系统操作员" & vbCrLf & _
"函数格式:" & vbCrLf & _
" OPERATOR()" & vbCrLf & _
" 不许任何参数? "
ReDim mai_parmtype_ncs(1) As Integer
ReDim mai_parmdefault_ncs(1) As Integer
mai_parmtype_ncs(0) = 1
mai_parmdefault_ncs(0) = 1
rt = Cell1.DoAddUserFunctionEx("系统基本函数", "OPERATOR", 4, 0, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'15.SQL语句 all
ls_hssm = "函数名称:SQL_ALL" & vbCrLf & _
" 生成SQL语句查询出的结果报表" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SQL_ALL(""SQL语句"",""年月字段名"",""年"",""月"",""标志"")" & vbCrLf & _
"参数必须为如下格式:" & vbCrLf & _
" SQL语句:select 字段名 [as 别名] from 数据表名 [where 条件] " & vbCrLf & _
" 年月字段名:输入库中年月字段名,若年月为两个字段,用逗号分隔" & vbCrLf & _
" 若年月字段为字符型,在年月字段名末尾加一个 $ 符号" & vbCrLf & _
" 若该参数为空时,后面年月参数不起作用" & vbCrLf & _
" 年: 可以输入本年?去年或2000?1999等任何数字" & vbCrLf & _
" 月: 可以输入本月?上月或1?...?12等? " & vbCrLf & _
" 标志: 0--不显示字段名 1--显示字段名"
ReDim mai_parmtype_ncs(5) As Integer
ReDim mai_parmdefault_ncs(5) As Integer
For i = 0 To 5
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("SQL通用函数", "SQL_ALL", 4, 5, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'15.SQL语句 RowCol
ls_hssm = "函数名称:SQL_RowCol" & vbCrLf & _
" 生成SQL语句查询出的结果报表(不带网格）" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SQL_RowCol(""SQL语句"",""年月字段名"",""年"",""月"")" & vbCrLf & _
"参数必须为如下格式:" & vbCrLf & _
" SQL语句:select 字段名 [as 别名] from 数据表名 [where 条件] " & vbCrLf & _
" 年月字段名:输入库中年月字段名,若年月为两个字段,用逗号分隔" & vbCrLf & _
" 若年月字段为字符型,在年月字段名末尾加一个 $ 符号" & vbCrLf & _
" 若该参数为空时,后面年月参数不起作用" & vbCrLf & _
" 年: 可以输入本年?去年或2000?1999等任何数字" & vbCrLf & _
" 月: 可以输入本月?上月或1?...?12等? "
ReDim mai_parmtype_ncs(4) As Integer
ReDim mai_parmdefault_ncs(4) As Integer
For i = 0 To 4
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("SQL通用函数", "SQL_RowCol", 4, 4, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'16.SQL语句 ODBC
ls_hssm = "函数名称:SQL_ODBC" & vbCrLf & _
" 生成SQL语句查询出的结果报表" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SQL_ODBC(""SQL语句"",""机器数据源名"",""用户标识"",""口令"")" & vbCrLf & _
"参数必须为如下格式:" & vbCrLf & _
" SQL语句: select 字段名 [as 别名] from 数据表名 [where 条件]? " & vbCrLf & _
" 机器数据源名: 由ODBC定义的机器数据源名" & vbCrLf & _
" 用户标识: 使用数据库合法的用户标识 " & vbCrLf & _
" 口令: 用户口令"
ReDim mai_parmtype_ncs(4) As Integer
ReDim mai_parmdefault_ncs(4) As Integer
For i = 0 To 4
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("SQL通用函数", "SQL_ODBC", 4, 4, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'17.SQL语句 CELL
ls_hssm = "函数名称:SQL_CELL" & vbCrLf & _
" 返回SQL语句查询结果的第一个字段内容填入单元格" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SQL_CELL(""SQL语句"",""年月字段名"",""年"",""月"")" & vbCrLf & _
"参数必须为如下格式:" & vbCrLf & _
" SQL语句:select 字段名 [as 别名] from 数据表名 [where 条件] " & vbCrLf & _
" 年月字段名:输入库中年月字段名,若年月为两个字段,用逗号分隔" & vbCrLf & _
" 若年月字段为字符型,在年月字段名末尾加一个 $ 符号" & vbCrLf & _
" 若该参数为空时,后面年月参数不起作用" & vbCrLf & _
" 年: 可以输入本年?去年或2000?1999等任何数字" & vbCrLf & _
" 月: 可以输入本月?上月或1?...?12等? "
ReDim mai_parmtype_ncs(4) As Integer
ReDim mai_parmdefault_ncs(4) As Integer
For i = 0 To 4
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("SQL通用函数", "SQL_Cell", 4, 4, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'18.SQL语句 col
ls_hssm = "函数名称:SQL_Col" & vbCrLf & _
" 返回SQL语句查询结果的第一个字段内容填入单元格所在的列" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SQL_Col(""SQL语句"",""年月字段名"",""年"",""月"")" & vbCrLf & _
"参数必须为如下格式:" & vbCrLf & _
" SQL语句:select 字段名 [as 别名] from 数据表名 [where 条件] " & vbCrLf & _
" 年月字段名:输入库中年月字段名,若年月为两个字段,用逗号分隔" & vbCrLf & _
" 若年月字段为字符型,在年月字段名末尾加一个 $ 符号" & vbCrLf & _
" 若该参数为空时,后面年月参数不起作用" & vbCrLf & _
" 年: 可以输入本年?去年或2000?1999等任何数字" & vbCrLf & _
" 月: 可以输入本月?上月或1?...?12等? "
ReDim mai_parmtype_ncs(4) As Integer
ReDim mai_parmdefault_ncs(4) As Integer
For i = 0 To 4
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("SQL通用函数", "SQL_Col", 4, 4, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'19.SQL语句 row
ls_hssm = "函数名称:SQL_Row" & vbCrLf & _
" 返回SQL语句查询结果的第一个字段内容填入单元格所在的行" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SQL_Row(""SQL语句"",""年月字段名"",""年"",""月"")" & vbCrLf & _
"参数必须为如下格式:" & vbCrLf & _
" SQL语句:select 字段名 [as 别名] from 数据表名 [where 条件] " & vbCrLf & _
" 年月字段名:输入库中年月字段名,若年月为两个字段,用逗号分隔" & vbCrLf & _
" 若年月字段为字符型,在年月字段名末尾加一个 $ 符号" & vbCrLf & _
" 若该参数为空时,后面年月参数不起作用" & vbCrLf & _
" 年: 可以输入本年?去年或2000?1999等任何数字" & vbCrLf & _
" 月: 可以输入本月?上月或1?...?12等? "
ReDim mai_parmtype_ncs(4) As Integer
ReDim mai_parmdefault_ncs(4) As Integer
For i = 0 To 4
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("SQL通用函数", "SQL_Row", 4, 4, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'20.读取电子报表系统数据
ls_hssm = "函数名称:READ_DATA" & vbCrLf & _
" 追加一个表页,返回满足条件的电子报表系统月报数据" & vbCrLf & _
"函数格式:" & vbCrLf & _
" READ_DATA(""应用系统编号"",""报表模板编号"",""年"",""月"")" & vbCrLf & _
"参数必须为如下格式:" & vbCrLf & _
" 应用系统编号:输入当前所使用的应用系统编号 " & vbCrLf & _
" 报表模板编号:输入要读取报表数据的报表模板编号 " & vbCrLf & _
" 年: 可以输入本年?去年或2000?1999等任何数字" & vbCrLf & _
" 月: 可以输入本月?上月或1?...?12等? "
ReDim mai_parmtype_ncs(4) As Integer
ReDim mai_parmdefault_ncs(4) As Integer
For i = 0 To 4
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("系统基本函数", "READ_DATA", 4, 4, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
'22.保存数据到数据库中
ls_hssm = "函数名称:SAVE_DATA" & vbCrLf & _
" 将CELL控件中某些单元格数据写入数据库的数据表中" & vbCrLf & _
"函数格式:" & vbCrLf & _
" SAVE_DATA(""数据表名"",""单元格字符串"")" & vbCrLf & _
"参数必须为如下格式:" & vbCrLf & _
" 数据表名:要写入数据的数据表名 " & vbCrLf & _
" 单元格字符串:指定单元格位置,单元格与单元格之间需要用$字符分隔" & vbCrLf & _
" 如:A2$B3$D3表示将A2?B3?D3单元格内容写入指定数据表的一条记录中,第一个单元格为关键字?"
ReDim mai_parmtype_ncs(2) As Integer
ReDim mai_parmdefault_ncs(2) As Integer
For i = 0 To 2
mai_parmtype_ncs(i) = 1
mai_parmdefault_ncs(i) = 1
Next i
rt = Cell1.DoAddUserFunctionEx("系统基本函数", "SAVE_DATA", 4, 2, mai_parmtype_ncs(0), mai_parmdefault_ncs(0), ls_hssm)
If rt = False Then MsgBox "增加用户自定义函数失败!", vbOKOnly, "百利/ERP5.0-电子报表"
End Function
Public Sub mf_saveas()
Dim ls_filename As String
CommonDialog1.Filter = "CLL文件(*.cll)|*.cll|"
CommonDialog1.Flags = cdlOFNFileMustExist
Select Case Me.ml_edit_lx
Case 1
CommonDialog1.FileName = Me.mcls_open_report.ls_report_model_name
Case 2
CommonDialog1.FileName = Me.mcls_open_report_model.ls_report_model_name
Case 3
CommonDialog1.FileName = ms_filename
Case 4
CommonDialog1.FileName = Me.mcls_new_report.ls_report_model_name
Case 5
CommonDialog1.FileName = Me.mcls_new_report_model.ls_report_model_name
Case 6
CommonDialog1.FileName = Right(Me.Caption, Len(Me.Caption) - 9)
End Select
CommonDialog1.FileName = ""
CommonDialog1.DialogTitle = "请输入您要保存的文件的名称"
CommonDialog1.ShowSave
ls_filename = CommonDialog1.FileName
If Len(Trim(ls_filename)) = 0 Then
Exit Sub
End If
If Cell1.DoSaveFile(ls_filename) > 0 Then
ms_filename = ls_filename
Me.Caption = "编辑表格: " & ms_filename
Me.ml_edit_lx = 3
Me.Cell1.DoSetModifiedFlag False
Else
MsgBox "文件保存失败", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
Exit Sub
End If
End Sub
Private Function mf_cell_login() As Boolean
mf_cell_login = Cell1.DoLogin("北京华夏新达科技股份有限公司", 325, "00FD18FF080193035CFE09FF7D09")
mf_cell_login = True
End Function
Private Sub mf_cell_toolbar() '设置与当前单元相关的工具栏状态
Dim ls_fontname, ll_size, ll_style
Dim ll_forecolor, ll_backcolor, ll_alignment As Long
On Error Resume Next
Cell1.DoGetCellFont ml_col, ml_row, ll_size, ll_style, ls_fontname
ll_alignment = Cell1.DoGetCellAlignment(ml_col, ml_row)
With MDI_frame
.Combo2.Text = CStr(ll_size) '设置字体大小工具栏
If Cell1.DoGetCellTextStyle(ml_col, ml_row) = 1 Then
.Toolbar3.Buttons("zhxs").Value = tbrPressed
Else
.Toolbar3.Buttons("zhxs").Value = tbrUnpressed
End If
Select Case ll_alignment '设置对齐
Case 9
.Toolbar3.Buttons("left").Value = tbrPressed
.Toolbar3.Buttons("mid_sp").Value = tbrUnpressed
.Toolbar3.Buttons("right").Value = tbrUnpressed
.Toolbar3.Buttons("top").Value = tbrPressed
.Toolbar3.Buttons("mid_cz").Value = tbrUnpressed
.Toolbar3.Buttons("bottom").Value = tbrUnpressed
Case 33
.Toolbar3.Buttons("left").Value = tbrPressed
.Toolbar3.Buttons("mid_sp").Value = tbrUnpressed
.Toolbar3.Buttons("right").Value = tbrUnpressed
.Toolbar3.Buttons("top").Value = tbrUnpressed
.Toolbar3.Buttons("mid_cz").Value = tbrPressed
.Toolbar3.Buttons("bottom").Value = tbrUnpressed
Case 17, 0
.Toolbar3.Buttons("left").Value = tbrPressed
.Toolbar3.Buttons("mid_sp").Value = tbrUnpressed
.Toolbar3.Buttons("right").Value = tbrUnpressed
.Toolbar3.Buttons("top").Value = tbrUnpressed
.Toolbar3.Buttons("mid_cz").Value = tbrUnpressed
.Toolbar3.Buttons("bottom").Value = tbrPressed
Case 12
.Toolbar3.Buttons("left").Value = tbrUnpressed
.Toolbar3.Buttons("mid_sp").Value = tbrPressed
.Toolbar3.Buttons("right").Value = tbrUnpressed
.Toolbar3.Buttons("top").Value = tbrPressed
.Toolbar3.Buttons("mid_cz").Value = tbrUnpressed
.Toolbar3.Buttons("bottom").Value = tbrUnpressed
Case 36
.Toolbar3.Buttons("left").Value = tbrUnpressed
.Toolbar3.Buttons("mid_sp").Value = tbrPressed
.Toolbar3.Buttons("right").Value = tbrUnpressed
.Toolbar3.Buttons("top").Value = tbrUnpressed
.Toolbar3.Buttons("mid_cz").Value = tbrPressed
.Toolbar3.Buttons("bottom").Value = tbrUnpressed
Case 20
.Toolbar3.Buttons("left").Value = tbrUnpressed
.Toolbar3.Buttons("mid_sp").Value = tbrPressed
.Toolbar3.Buttons("right").Value = tbrUnpressed
.Toolbar3.Buttons("top").Value = tbrUnpressed
.Toolbar3.Buttons("mid_cz").Value = tbrUnpressed
.Toolbar3.Buttons("bottom").Value = tbrPressed
Case 10
.Toolbar3.Buttons("left").Value = tbrUnpressed
.Toolbar3.Buttons("mid_sp").Value = tbrUnpressed
.Toolbar3.Buttons("right").Value = tbrPressed
.Toolbar3.Buttons("top").Value = tbrPressed
.Toolbar3.Buttons("mid_cz").Value = tbrUnpressed
.Toolbar3.Buttons("bottom").Value = tbrUnpressed
Case 34
.Toolbar3.Buttons("left").Value = tbrUnpressed
.Toolbar3.Buttons("mid_sp").Value = tbrUnpressed
.Toolbar3.Buttons("right").Value = tbrPressed
.Toolbar3.Buttons("top").Value = tbrUnpressed
.Toolbar3.Buttons("mid_cz").Value = tbrPressed
.Toolbar3.Buttons("bottom").Value = tbrUnpressed
Case 18
.Toolbar3.Buttons("left").Value = tbrUnpressed
.Toolbar3.Buttons("mid_sp").Value = tbrUnpressed
.Toolbar3.Buttons("right").Value = tbrPressed
.Toolbar3.Buttons("top").Value = tbrUnpressed
.Toolbar3.Buttons("mid_cz").Value = tbrUnpressed
.Toolbar3.Buttons("bottom").Value = tbrPressed
End Select
Select Case ll_style '设置字体风格工具栏
Case 0
.Toolbar3.Buttons("jiacu").Value = tbrUnpressed
.Toolbar3.Buttons("qinxie").Value = tbrUnpressed
.Toolbar3.Buttons("xiahuaxian").Value = tbrUnpressed
Case 1
.Toolbar3.Buttons("jiacu").Value = tbrPressed
.Toolbar3.Buttons("qinxie").Value = tbrUnpressed
.Toolbar3.Buttons("xiahuaxian").Value = tbrUnpressed
Case 2
.Toolbar3.Buttons("jiacu").Value = tbrUnpressed
.Toolbar3.Buttons("qinxie").Value = tbrPressed
.Toolbar3.Buttons("xiahuaxian").Value = tbrUnpressed
Case 3
.Toolbar3.Buttons("jiacu").Value = tbrUnpressed
.Toolbar3.Buttons("qinxie").Value = tbrUnpressed
.Toolbar3.Buttons("xiahuaxian").Value = tbrPressed
Case 4
.Toolbar3.Buttons("jiacu").Value = tbrPressed
.Toolbar3.Buttons("qinxie").Value = tbrPressed
.Toolbar3.Buttons("xiahuaxian").Value = tbrUnpressed
Case 5
.Toolbar3.Buttons("jiacu").Value = tbrPressed
.Toolbar3.Buttons("qinxie").Value = tbrUnpressed
.Toolbar3.Buttons("xiahuaxian").Value = tbrPressed
Case 6
.Toolbar3.Buttons("jiacu").Value = tbrUnpressed
.Toolbar3.Buttons("qinxie").Value = tbrPressed
.Toolbar3.Buttons("xiahuaxian").Value = tbrPressed
Case 7
.Toolbar3.Buttons("jiacu").Value = tbrPressed
.Toolbar3.Buttons("qinxie").Value = tbrPressed
.Toolbar3.Buttons("xiahuaxian").Value = tbrPressed
End Select
.ActiveForm.Cell1.DoGetCellColor .ActiveForm.ml_col, .ActiveForm.ml_row, ll_forecolor, ll_backcolor
Select Case ll_forecolor '设置字体颜色工具栏
Case RGB(0, 0, 0), -1
.Toolbar3.Buttons("color").Image = 15
Case RGB(128, 128, 128)
.Toolbar3.Buttons("color").Image = 16
Case RGB(128, 0, 0)
.Toolbar3.Buttons("color").Image = 17
Case RGB(128, 128, 0)
.Toolbar3.Buttons("color").Image = 18
Case RGB(0, 128, 0)
.Toolbar3.Buttons("color").Image = 19
Case RGB(0, 128, 128)
.Toolbar3.Buttons("color").Image = 20
Case RGB(0, 0, 128)
.Toolbar3.Buttons("color").Image = 21
Case RGB(128, 0, 128)
.Toolbar3.Buttons("color").Image = 22
Case RGB(128, 128, 64)
.Toolbar3.Buttons("color").Image = 23
Case RGB(0, 64, 64)
.Toolbar3.Buttons("color").Image = 24
Case RGB(0, 128, 255)
.Toolbar3.Buttons("color").Image = 25
Case RGB(0, 64, 128)
.Toolbar3.Buttons("color").Image = 26
Case RGB(64, 0, 255)
.Toolbar3.Buttons("color").Image = 27
Case RGB(128, 64, 0)
.Toolbar3.Buttons("color").Image = 28
Case RGB(255, 255, 255)
.Toolbar3.Buttons("color").Image = 29
Case RGB(255, 0, 0)
.Toolbar3.Buttons("color").Image = 30
Case RGB(255, 255, 0)
.Toolbar3.Buttons("color").Image = 31
Case RGB(0, 255, 0)
.Toolbar3.Buttons("color").Image = 32
Case RGB(0, 255, 255)
.Toolbar3.Buttons("color").Image = 33
Case RGB(0, 0, 255)
.Toolbar3.Buttons("color").Image = 34
Case RGB(255, 0, 255)
.Toolbar3.Buttons("color").Image = 35
Case RGB(255, 255, 128)
.Toolbar3.Buttons("color").Image = 36
Case RGB(0, 255, 128)
.Toolbar3.Buttons("color").Image = 37
Case RGB(128, 255, 255)
.Toolbar3.Buttons("color").Image = 38
Case RGB(128, 128, 255)
.Toolbar3.Buttons("color").Image = 39
Case RGB(255, 0, 128)
.Toolbar3.Buttons("color").Image = 40
Case RGB(255, 128, 64)
.Toolbar3.Buttons("color").Image = 41
End Select
'设置数值格式
Dim ll_qfw, ll_bfs, ll_xsws, ll_hbfh, ll_unit, ll_fs, ll_kxjs
.ActiveForm.Cell1.DoGetCellNumberStyle .ActiveForm.ml_col, .ActiveForm.ml_row, ll_qfw, ll_bfs, ll_xsws, ll_hbfh, ll_unit, ll_fs, ll_kxjs
If ll_qfw = 1 Then
.Toolbar3.Buttons(",").Value = tbrPressed
Else
.Toolbar3.Buttons(",").Value = tbrUnpressed
End If
If ll_hbfh = 0 Then
.Toolbar3.Buttons("hbfh").Value = tbrPressed
Else
.Toolbar3.Buttons("hbfh").Value = tbrUnpressed
End If
If ll_bfs = 1 Then
.Toolbar3.Buttons("%").Value = tbrPressed
Else
.Toolbar3.Buttons("%").Value = tbrUnpressed
End If
If ll_kxjs = 1 Then
.Toolbar3.Buttons("E").Value = tbrPressed
Else
.Toolbar3.Buttons("E").Value = tbrUnpressed
End If
End With
End Sub
'读入数据
Public Sub mf_open(ByVal ll_edit_lx As Long)
Dim ls_select As String, ll_nr_len As Long
Dim ls_filename As String, ll_filenumber As Long
Dim lrst_open As ADODB.Recordset
Dim laby_nr() As Byte, ls_path As String
on error resume next
Select Case ll_edit_lx
Case 1
MDI_frame.m_recompute.Enabled = False
Set lrst_open = New ADODB.Recordset
With Me.mcls_open_report
ls_select = "select report_nr from dzbb_bb where system_code='" & Left(.ls_system_code, 2) _
& "' and report_model_id='" & .ls_report_model_id _
& "' and report_time='" & CStr(.ldate_report_time) & "'"
lrst_open.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic, adCmdText
lrst_open.MoveFirst
ll_nr_len = lrst_open("report_nr").ActualSize
ReDim laby_nr(ll_nr_len)
laby_nr = lrst_open("report_nr").GetChunk(ll_nr_len)
ls_path = App.Path
If Right(ls_path, 1) <> "" Then
ls_path = ls_path & ""
End If
ls_filename = ls_path & "hbbb_tmp.cll"
ll_filenumber = FreeFile()
Open ls_filename For Binary As #ll_filenumber
Put #ll_filenumber, 1, laby_nr
Close #ll_filenumber
Cell1.DoOpenFile ls_filename
Kill ls_filename
End With
lrst_open.Close
Set lrst_open = Nothing
Case 2
Set lrst_open = New ADODB.Recordset
With Me.mcls_open_report_model
ls_select = "select report_model_nr from dzbb_bbmb where system_code='" & Left(.ls_system_code, 2) _
& "' and report_model_id='" & .ls_report_model_id & "'"
lrst_open.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic, adCmdText
lrst_open.MoveFirst
ll_nr_len = lrst_open("report_model_nr").ActualSize
ReDim laby_nr(ll_nr_len)
laby_nr = lrst_open("report_model_nr").GetChunk(ll_nr_len)
ls_path = App.Path
If Right(ls_path, 1) <> "" Then
ls_path = ls_path & ""
End If
ls_filename = ls_path & "hbbb_tmp.cll"
ll_filenumber = FreeFile()
Open ls_filename For Binary As #ll_filenumber
Put #ll_filenumber, 1, laby_nr
Close #ll_filenumber
Cell1.DoOpenFile ls_filename
Kill ls_filename
End With
lrst_open.Close
Set lrst_open = Nothing
Case 3
If Cell1.DoOpenFile(ms_filename) <= 0 Then
MsgBox ms_filename
MsgBox "打开文件失败!", vbOKOnly, "百利/ERP5.0-电子报表"
Exit Sub
End If
Case 4
Dim ll_forecolor, ll_backcolor, i As Long, j As Long
Set lrst_open = New ADODB.Recordset
With Me.mcls_new_report
ls_select = "select report_model_nr from dzbb_bbmb where system_code='" & Left(.ls_system_code, 2) _
& "' and report_model_id='" & .ls_report_model_id & "'"
lrst_open.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic, adCmdText
lrst_open.MoveFirst
ll_nr_len = lrst_open("report_model_nr").ActualSize
ReDim laby_nr(ll_nr_len)
laby_nr = lrst_open("report_model_nr").GetChunk(ll_nr_len)
ls_path = App.Path
If Right(ls_path, 1) <> "" Then
ls_path = ls_path & ""
End If
ls_filename = ls_path & "hbbb_tmp.cll"
ll_filenumber = FreeFile()
Open ls_filename For Binary As #ll_filenumber
Put #ll_filenumber, 1, laby_nr
Close #ll_filenumber
Cell1.DoOpenFile ls_filename
Kill ls_filename
If .ls_report_model_id = "00001" Or .ls_report_model_id = "00002" Or .ls_report_model_id = "00003" Then
Cell1.DoCalculateAll
Else
Cell1.DoCalculateAll
End If
For i = 0 To Cell1.Cols - 1
For j = 0 To Cell1.Rows - 1
Cell1.DoGetCellColor i, j, ll_forecolor, ll_backcolor
Cell1.DoSetCellColor i, j, ll_forecolor, -1
If Cell1.IsFormulaCell(i, j) Then
If Left(Cell1.DoGetCellNote(i, j), 1) = "1" Then
Cell1.DoDelFormula i, j
End If
End If
If Cell1.IsChartCell(i, j) Then
Cell1.DoRefreshChart i, j
End If
Next j
Next i
Cell1.DoRedrawAll
End With
lrst_open.Close
Set lrst_open = Nothing
'case 5,6不用取数
Case 7
MDI_frame.m_recompute.Enabled = False
For i = 1 To frm_open_bbHZ.vsFlexGrid2.Rows - 1
If frm_open_bbHZ.vsFlexGrid2.TextMatrix(i, 4) = "√" Then
Set lrst_open = New ADODB.Recordset
With Me.mcls_open_report
ls_select = "select report_nr from dzbb_bb where system_code='" & Left(ls_xtbm, 2) _
& "' and report_model_id='" & frm_open_bbHZ.vsFlexGrid1.TextMatrix(frm_open_bbHZ.vsFlexGrid1.Row, 0) _
& "' and report_time='" & CStr(frm_open_bbHZ.vsFlexGrid2.TextMatrix(i, 0)) & "'"
lrst_open.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic, adCmdText
lrst_open.MoveFirst
ll_nr_len = lrst_open("report_nr").ActualSize
ReDim laby_nr(ll_nr_len)
laby_nr = lrst_open("report_nr").GetChunk(ll_nr_len)
ls_path = App.Path
If Right(ls_path, 1) <> "" Then
ls_path = ls_path & ""
End If
ls_filename = ls_path & "hbbb_tmp.cll"
ll_filenumber = FreeFile()
Open ls_filename For Binary As #ll_filenumber
Put #ll_filenumber, 1, laby_nr
Close #ll_filenumber
Cell1.DoOpenFile ls_filename
Cell1.DoAppendPage "", 1
Cell1.DoCopyPage Cell1.DoGetTotalPages - 1, 0
Kill ls_filename
End With
lrst_open.Close
Set lrst_open = Nothing
End If
Next i
Cell1.DoDeletePage 0, 1
For i = Cell1.DoGetTotalPages - 1 To 0 Step -1
Cell1.DoSetCurrentPage i
Cell1.DoSetTopRow 0
Cell1.DoSetLeftCol 0
Next i
End Select
End Sub
Public Sub mf_save(ByVal ll_edit_lx)
If song_flag = False Then
Dim ls_sql As String, ls_filename As String
Dim ll_filenumber As Long, ll_filelen As Long
Dim lrst_save As ADODB.Recordset
Dim lrst_read As ADODB.Recordset
Dim laby_cell() As Byte
Dim ls_path
On Error GoTo error_save
Cw_DataEnvi.dataconnect.BeginTrans
Select Case ll_edit_lx
Case 1
ls_path = App.Path
If Right(ls_path, 1) <> "" Then
ls_path = ls_path & ""
End If
ls_filename = ls_path + "dzbb_temp.cll"
If Dir(ls_filename) <> "" Then
Kill ls_filename
End If
If Cell1.DoSaveFile(ls_filename) <= 0 Then
MsgBox "保存到临时文件失败,报表保存失败!", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
End If
ll_filenumber = FreeFile()
Open ls_filename For Binary As #ll_filenumber
ll_filelen = LOF(ll_filenumber)
ReDim laby_cell(ll_filelen)
Get #ll_filenumber, 1, laby_cell
Close #ll_filenumber
Set lrst_save = New ADODB.Recordset
With Me.mcls_open_report
ls_sql = "select * from dzbb_bb where system_code='" & Left(.ls_system_code, 2) _
& "' and report_model_id='" & .ls_report_model_id _
& "' and report_time='" & CStr(.ldate_report_time) & "'"
lrst_save.Open ls_sql, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
lrst_save.MoveFirst
lrst_save("update_id") = Xtczybm
lrst_save("update_time") = Xtrq
lrst_save("report_nr").AppendChunk laby_cell
lrst_save.Update
lrst_save.Close
Set lrst_save = Nothing
Cell1.DoSetModifiedFlag False
End With
Kill ls_filename
MsgBox "报表保存成功!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
Case 2 '修改报表莫板存盘
frm_user_right1.Show vbModal, MDI_frame
ls_path = App.Path
If Right(ls_path, 1) <> "" Then
ls_path = ls_path & ""
End If
ls_filename = ls_path + "dzbb_temp.cll"
If Cell1.DoSaveFile(ls_filename) <= 0 Then
MsgBox "保存到临时文件失败,报表模板保存失败!", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
End If
ll_filenumber = FreeFile()
Open ls_filename For Binary As #ll_filenumber
ll_filelen = LOF(ll_filenumber)
ReDim laby_cell(ll_filelen)
Get #ll_filenumber, 1, laby_cell
Close #ll_filenumber
Set lrst_save = New ADODB.Recordset
With Me.mcls_open_report_model
ls_sql = "select * from dzbb_bbmb where system_code='" & Left(.ls_system_code, 2) _
& "' and report_model_id='" & .ls_report_model_id & "'"
lrst_save.Open ls_sql, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
lrst_save.MoveFirst
lrst_save("report_model_nr").AppendChunk laby_cell
lrst_save("canmakdate") = frm_user_right1.Combo1.Text
lrst_save.Update
lrst_save.Close
'*********************************************
lrst_save.Open "delete from dzbb_right where system_code='" & Left(.ls_system_code, 2) _
& "' and report_model_id='" & .ls_report_model_id & "'", Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
lrst_save.Open "select * from dzbb_right where system_code='" & Left(.ls_system_code, 2) _
& "' and report_model_id='" & .ls_report_model_id & "'", Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
For i = 0 To frm_user_right1.vs1.Rows - 1
If frm_user_right1.vs1.TextMatrix(i, 2) = "√" Or frm_user_right1.vs1.TextMatrix(i, 3) = "√" Then
lrst_save.AddNew
lrst_save("system_code") = Left(.ls_system_code, 2)
lrst_save("report_model_id") = .ls_report_model_id
lrst_save("user_id") = Xtczybm
lrst_save("bbuser_id") = Trim(frm_user_right1.vs1.TextMatrix(i, 0))
If frm_user_right1.vs1.TextMatrix(i, 2) = "√" Then
lrst_save("editflag") = 1
Else
lrst_save("editflag") = 0
End If
lrst_save.Update
End If
Next i
lrst_save.Close
Unload frm_user_right1
'**********************************************
Set lrst_save = Nothing
Cell1.DoSetModifiedFlag False
End With
MsgBox "报表模板保存成功!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
Kill ls_filename
Case 3
If Dir(ms_filename) <> "" Then
If MsgBox("文件已存在,要覆盖吗?", vbQuestion + vbYesNo, "提示信息——百利/ERP5.0-电子报表") = vbNo Then
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
Else
Kill ms_filename
End If
End If
If Cell1.DoSaveFile(ms_filename) <= 0 Then
MsgBox "文件保存失败!", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
End If
MsgBox "报表保存成功!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
Case 4
ls_path = App.Path
If Right(ls_path, 1) <> "" Then
ls_path = ls_path & ""
End If
ls_filename = ls_path + "dzbb_temp.cll"
If Dir(ls_filename) <> "" Then
Kill ls_filename
End If
If Cell1.DoSaveFile(ls_filename) <= 0 Then
MsgBox "保存到临时文件失败,报表保存失败!", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
End If
ll_filenumber = FreeFile
Open ls_filename For Binary As #ll_filenumber
ll_filelen = LOF(ll_filenumber)
ReDim laby_cell(ll_filelen)
Get #ll_filenumber, 1, laby_cell
Close #ll_filenumber
Set lrst_save = New ADODB.Recordset
With Me.mcls_new_report
If Len(ms_save_time) = 0 Then
ms_save_time = Format(Xtrq, "yyyy-mm-dd")
End If
ls_sql = "select canmakdate from dzbb_bbmb where system_code='" & Left(ls_xtbm, 2) & "' and report_model_id ='" & .ls_report_model_id & "'"
Set lrst_read = Cw_DataEnvi.dataconnect.Execute(ls_sql)
If lrst_read.EOF = False Then
Select Case Trim(lrst_read("canmakdate"))
Case "年报"
ms_save_time = Left(ms_save_time, 4) & "年"
Case "季报"
Select Case Month(CDate(ms_save_time))
Case 1, 2, 3
ms_save_time = Left(ms_save_time, 4) & "年一季度"
Case 4, 5, 6
ms_save_time = Left(ms_save_time, 4) & "年二季度"
Case 7, 8, 9
ms_save_time = Left(ms_save_time, 4) & "年三季度"
Case 10, 11, 12
ms_save_time = Left(ms_save_time, 4) & "年四季度"
End Select
Case "月报"
ms_save_time = Left(ms_save_time, 7)
Case "旬报"
If Day(CDate(ms_save_time)) < 11 Then
ms_save_time = Left(ms_save_time, 7) & "月上旬"
ElseIf Day(CDate(ms_save_time)) < 21 And Day(CDate(ms_save_time)) > 10 Then
ms_save_time = Left(ms_save_time, 7) & "月中旬"
ElseIf Day(CDate(ms_save_time)) < 31 And Day(CDate(ms_save_time)) > 20 Then
ms_save_time = Left(ms_save_time, 7) & "月下旬"
End If
Case "日报"
End Select
End If
lrst_read.Close
Set lrst_read = Nothing
ls_sql = "select * from dzbb_bb where system_code='" & Left(.ls_system_code, 2) _
& "' and report_model_id='" & .ls_report_model_id _
& "' and report_time = '" & ms_save_time & "'"
lrst_save.Open ls_sql, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
If lrst_save.RecordCount = 0 Then
lrst_save.AddNew
lrst_save("user_id") = Xtczy
Else
If MsgBox("报表已存在,要覆盖吗?", vbQuestion + vbYesNo, "提示信息——百利/ERP5.0-电子报表") = vbNo Then
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
End If
End If
lrst_save("system_code") = Left(.ls_system_code, 2)
lrst_save("report_model_id") = .ls_report_model_id
lrst_save("report_time") = ms_save_time
lrst_save("update_time") = Xtrq
lrst_save("update_id") = Xtczy
lrst_save("report_nr").AppendChunk laby_cell
lrst_save.Update
lrst_save.Close
Set lrst_save = Nothing
Cell1.DoSetModifiedFlag False
End With
Kill ls_filename
MsgBox "报表保存成功!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
Case 5 '新建报表模板存盘
frm_user_right.Show vbModal, MDI_frame '设置right
ls_path = App.Path
If Right(ls_path, 1) <> "" Then
ls_path = ls_path & ""
End If
ls_filename = ls_path + "dzbb_temp.cll"
If Cell1.DoSaveFile(ls_filename) <= 0 Then
Cw_DataEnvi.dataconnect.RollbackTrans
MsgBox "保存到临时文件失败,报表模板保存失败!", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
Exit Sub
End If
ll_filenumber = FreeFile
Open ls_filename For Binary As #ll_filenumber
ll_filelen = LOF(ll_filenumber)
ReDim laby_cell(ll_filelen)
Get #ll_filenumber, 1, laby_cell
Close #ll_filenumber
Set lrst_save = New ADODB.Recordset
With Me.mcls_new_report_model
ls_sql = "select * from dzbb_bbmb where system_code='" & Left(.ls_system_code, 2) _
& "' and report_model_id='" & .ls_report_model_id & "'"
lrst_save.Open ls_sql, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
If lrst_save.RecordCount = 0 Then
lrst_save.AddNew
End If
lrst_save("system_code") = Left(.ls_system_code, 2)
lrst_save("report_model_id") = .ls_report_model_id
lrst_save("report_model_name") = .ls_report_model_name
lrst_save("user_id") = Xtczybm
lrst_save("report_model_nr").AppendChunk laby_cell
lrst_save("canmakdate") = frm_user_right.Combo1.Text
lrst_save.Update
lrst_save.Close
'*********************************************
Cw_DataEnvi.dataconnect.Execute "delete from dzbb_right where system_code='" & Left(.ls_system_code, 2) & "' and report_model_id='" & .ls_report_model_id & "'"
lrst_save.Open "select * from dzbb_right ", Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
For i = 0 To frm_user_right.vs1.Rows - 1
If frm_user_right.vs1.TextMatrix(i, 2) = "√" Or frm_user_right.vs1.TextMatrix(i, 3) = "√" Then
lrst_save.AddNew
lrst_save("system_code") = Left(.ls_system_code, 2)
lrst_save("report_model_id") = .ls_report_model_id
lrst_save("user_id") = Xtczybm
lrst_save("bbuser_id") = Trim(frm_user_right.vs1.TextMatrix(i, 0))
If frm_user_right.vs1.TextMatrix(i, 2) = "√" Then
lrst_save("editflag") = 1
Else
lrst_save("editflag") = 0
End If
lrst_save.Update
End If
Next i
lrst_save.Close
Unload frm_user_right
'*********************************************
Set lrst_save = Nothing
Cell1.DoSetModifiedFlag False
End With
Kill ls_filename
MsgBox "报表模板保存成功!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
Case 6
CommonDialog1.Filter = "CLL文件(*.cll)|*.cll|"
CommonDialog1.Flags = cdlOFNFileMustExist
'CommonDialog1.FileName = Right(Me.Caption, Len(Me.Caption) - 9) & ".cll"
CommonDialog1.FileName = ""
CommonDialog1.DialogTitle = "请输入您要保存的文件的名称"
CommonDialog1.ShowSave
ls_filename = CommonDialog1.FileName
If Len(Trim(ls_filename)) = 0 Then
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
End If
If Cell1.DoSaveFile(ls_filename) > 0 Then
ms_filename = ls_filename
Me.ml_edit_lx = 3
Me.Caption = "编辑表格: " & ms_filename
Else
MsgBox "文件保存失败", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
End If
Exit Sub
End Select
Else
Dim lrst_select As New ADODB.Recordset
Dim ls_select As String
ls_path = App.Path
If Right(ls_path, 1) <> "" Then
ls_path = ls_path & ""
End If
frm_user_right1.Show vbModal, MDI_frame
ls_filename = ls_path + "dzbb_temp.cll"
If Dir(ls_filename) <> "" Then
Kill ls_filename
End If
If MDI_frame.ActiveForm.Cell1.DoSaveFile(ls_filename) <= 0 Then
MsgBox "保存到临时文件失败,报表模板保存失败!", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
End If
ll_filenumber = FreeFile()
Open ls_filename For Binary As #ll_filenumber
ll_filelen = LOF(ll_filenumber)
ReDim laby_cell(ll_filelen)
Get #ll_filenumber, 1, laby_cell
Close #ll_filenumber
ls_select = "select * from dzbb_bbmb where system_code='" & Left(ls_xtbm, 2) & "' and report_model_id='" & Trim(Mid(MDI_frame.Caption, InStr(1, MDI_frame.Caption, "模板号:") + 4, 5)) & "'"
lrst_select.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic, 8
If lrst_select.RecordCount = 0 Then
MsgBox "保存出错,模板没有保存!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
If Dir(ls_filename) <> "" Then Kill ls_filename
Cw_DataEnvi.dataconnect.RollbackTrans
Exit Sub
Else
With lrst_select
.Fields("report_model_nr").AppendChunk laby_cell
.Fields("canmakdate") = frm_user_right1.Combo1.Text
.Update
End With
lrst_select.Close
'*********************************************
lrst_select.Open "delete from dzbb_right where system_code='" & Mid(MDI_frame.Caption, InStr(1, MDI_frame.Caption, "系统编码") + 5, 2) _
& "'and report_model_id='" & Mid(MDI_frame.Caption, InStr(1, MDI_frame.Caption, "模板号") + 4, 5) & "'", Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
lrst_select.Open "select * from dzbb_right where system_code='" & Mid(MDI_frame.Caption, InStr(1, MDI_frame.Caption, "系统编码") + 5, 2) _
& "' and report_model_id='" & Mid(MDI_frame.Caption, InStr(1, MDI_frame.Caption, "模板号") + 4, 5) & "'", Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic
For i = 0 To frm_user_right1.vs1.Rows - 1
If frm_user_right1.vs1.TextMatrix(i, 2) = "√" Then
lrst_select.AddNew
lrst_select("system_code") = Left(ls_xtbm, 2)
lrst_select("report_model_id") = Mid(MDI_frame.Caption, InStr(1, MDI_frame.Caption, "模板号") + 4, 5)
lrst_select("user_id") = Xtczybm
lrst_select("bbuser_id") = Trim(frm_user_right1.vs1.TextMatrix(i, 0))
lrst_select.Update
End If
Next i
lrst_select.Close
Unload frm_user_right1
If Dir(ls_filename) <> "" Then Kill ls_filename
MsgBox "文件保存文报表成功!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
End If
End If
Cw_DataEnvi.dataconnect.CommitTrans
Exit Sub
error_save:
On Error Resume Next
Set lrst_save = Nothing
Cw_DataEnvi.dataconnect.RollbackTrans
MsgBox "保存失败!", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
End Sub
Private Sub mf_setmenu(ByVal ll_count As Long)
'll_count为0:表示当前无打开文档,需要隐藏菜单
'll_count为1:表示当前第一次打开文档,需要显示菜单
With MDI_frame
If ll_count = 0 Then
.m_saveasmodel.Enabled = False
.m_saveasmodel.Visible = False
.m_close.Enabled = False
.m_save.Enabled = False
.m_lcwxtzygswj.Enabled = False
.m_drwj.Enabled = False
.m_lcwj.Enabled = False
.m_preview.Enabled = False
.m_print.Enabled = False
.m_edit.Enabled = False
.m_view.Enabled = False
.m_cell.Enabled = False
.m_page.Enabled = False
.m_data.Enabled = False
.m_biaoge.Enabled = False
.m_windows.Enabled = False
End If
If ll_count = 1 Then
If Xtczybm = "000" Then '判断是否管理员并设置菜单
.m_saveasmodel.Visible = True
.m_saveasmodel.Enabled = True
.m_fg6.Visible = True
.m_fill_formula.Visible = True
.m_fill_cf.Visible = True
.m_fill_cz.Visible = True
.m_fill_db.Visible = True
.m_fill_dc.Visible = True
.m_fill_nr.Visible = True
.m_page.Visible = True
.m_biaoge.Visible = True
.m_data.Visible = True
.m_manage.Visible = True
.m_fg6.Enabled = True
.m_fill_formula.Enabled = True
.m_fill_cf.Enabled = True
.m_fill_cz.Enabled = True
.m_fill_db.Enabled = True
.m_fill_dc.Enabled = True
.m_fill_nr.Enabled = True
.m_data.Enabled = True
.m_manage.Enabled = True
Else
.m_saveasmodel.Visible = False
.m_fg6.Visible = False
.m_fill_formula.Visible = False
.m_fill_cf.Visible = False
.m_fill_cz.Visible = False
.m_fill_db.Visible = False
.m_fill_dc.Visible = False
.m_fill_nr.Visible = False
.m_data.Visible = False
.m_manage.Visible = False
End If
.m_page.Visible = True
.m_biaoge.Visible = True
.YCHB.Checked = False
.YCLB.Checked = False
.m_close.Enabled = True
.m_save.Enabled = True
.m_lcwxtzygswj.Enabled = True
.m_drwj.Enabled = True
.m_lcwj.Enabled = True
.m_preview.Enabled = True
.m_print.Enabled = True
.m_edit.Enabled = True
.m_view.Enabled = True
.m_cell.Enabled = True
.m_page.Enabled = True
.m_data.Enabled = True