📄 frmfi_zzpzset.frm
字号:
Left = 120
TabIndex = 0
Top = 960
Width = 1305
End
Begin VB.Menu mnuFile
Caption = "文件(&F)"
Begin VB.Menu mnuPreview
Caption = "预览(&V)"
End
Begin VB.Menu mnuPrint
Caption = "打印(&P)"
Shortcut = ^P
End
Begin VB.Menu mnuBar1
Caption = "-"
End
Begin VB.Menu mnuClose
Caption = "关闭(&C)"
Shortcut = ^T
End
End
Begin VB.Menu mnuEdit
Caption = "编辑(&E)"
Begin VB.Menu mnuAdd
Caption = "增加(&A)"
End
Begin VB.Menu mnuXg
Caption = "修改(&C)"
Shortcut = ^E
End
Begin VB.Menu mnuDelete
Caption = "删除(&D)"
End
Begin VB.Menu mnuSave
Caption = "保存(&S)"
End
Begin VB.Menu mnuUndo
Caption = "取消(&U)"
End
End
Begin VB.Menu mnuOption
Caption = "操作(&O)"
Begin VB.Menu mnuAddRow
Caption = "增行"
End
Begin VB.Menu mnuDelRow
Caption = "删行"
End
End
Begin VB.Menu mnuHP
Caption = "帮助(&H)"
Begin VB.Menu mnuHelp
Caption = "帮助"
End
End
End
Attribute VB_Name = "frmFI_ZzpzSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************** Updated by Wan
Option Explicit
'yang 2000-12-14 开始编
''Dim bChange As Boolean
Dim sPzlb() As String
Dim iOldRow As Integer
Dim iOldCol As Integer
Public newZzxh As String
Public newZzsm As String
Public newZzlb As String
Dim frmH_Summ As frmIN_Summary
Dim bStartPrint As Boolean
Dim m_sPzType As String
Dim bFormulaErr As Boolean
Const COL_ID = 0
Const COL_SUMMARY = 2
Const COL_SUBJECT = 1
Const COL_ITEM = 4
Const COL_DEPARTMENT = 3
Const COL_DIRECT = 5
Const COL_FORMULA = 6
Public Property Let usPzType(ByVal sPzType As String)
m_sPzType = sPzType
End Property
Private Sub cboZzsm_Click()
cboZzXh.ListIndex = cboZzsm.ListIndex
End Sub
Private Sub cboZzXh_Click()
txtEdit.Visible = False
cmdHelp.Visible = False
Call FillOther
txtEdit.Visible = False
cmdHelp.Visible = False
End Sub
Private Function CheckIsCZ(newTable As String, newZD As String, ByVal newVal As String) As Boolean '是否存在
Dim rstTmp As New ADODB.Recordset
rstTmp.CursorLocation = adUseClient
rstTmp.Open "select * from " & newTable & " where " & newZD & "='" & newVal & "'", glo.cnnMain, adOpenStatic, adLockReadOnly
If rstTmp.RecordCount > 0 Then
CheckIsCZ = True
Else
CheckIsCZ = False
End If
End Function
Private Sub PrintMfg2(m_mFg As MSFlexGrid, sTitle As String)
'打印MFG控建
Dim rr As Long
Dim cc As Long
If m_mFg.Rows < 1 Then Exit Sub
If Printers.Count = 0 Then MsgBox "未安装打印机。", vbInformation: Exit Sub
cLlzzpz.OpenFile App.Path & "\CellFiles\ZzpzSet.cll", ""
cLlzzpz.ResetContent
cLlzzpz.PrintSetFoot "制作单位:" + GetEnterpriseName(""), "", "打印日期:" + glo.sOperateDate
cLlzzpz.PrintSetHead "", "", "总&S页 第&P页"
cLlzzpz.SetRows m_mFg.Rows + 3, 0
cLlzzpz.SetCols m_mFg.Cols + 2, 0
'第一行
cLlzzpz.s 1, 1, 0, sTitle
cLlzzpz.SetCellAlign 1, 1, 0, 32 + 4
cLlzzpz.SetCellFontStyle 1, 1, 0, 2
cLlzzpz.MergeCells 1, 1, cLlzzpz.GetCols(0) - 1, 1
cLlzzpz.SetCellFontSize 1, 1, 0, 16
cLlzzpz.SetRowHeight 1, 28, 1, 0
'第二行
cLlzzpz.s 1, 2, 0, "会计年度:" & glo.sOperateYear
' cLlzzpz.SetCellFontStyle 1, 2, 0, 2
cLlzzpz.SetCellAlign 1, 2, 0, 32 + 1
cLlzzpz.MergeCells 1, 2, cLlzzpz.GetCols(0) - 1, 2
'划线
cLlzzpz.DrawGridLine 1, 3, m_mFg.Cols, m_mFg.Rows + 2, 0, 2, 0
'设置列宽
For cc = 0 To m_mFg.Cols - 1
cLlzzpz.SetColWidth 1, m_mFg.ColWidth(cc) / 13, cc + 1, 0
cLlzzpz.SetCellAlign cc + 1, 3, 0, 32 + 4
Next cc
For rr = 0 To m_mFg.Rows - 1
For cc = 0 To m_mFg.Cols - 1
cLlzzpz.s cc + 1, rr + 3, 0, Trim(m_mFg.TextMatrix(rr, cc))
Next cc
Next rr
cLlzzpz.PrintSheet 1, 0
cLlzzpz.SaveFile App.Path & "\CellFiles\ZzpzSet.cll", 0
End Sub
Private Sub PrintMfg(m_mFg As MSFlexGrid, sTitle As String)
'打印MFG控建
Dim rr As Long
Dim cc As Long
If m_mFg.Rows < 1 Then Exit Sub
If Printers.Count = 0 Then MsgBox "未安装打印机。", vbInformation: Exit Sub
cLlzzpz.OpenFile App.Path & "\CellFiles\ZzpzSet.cll", ""
cLlzzpz.ResetContent
cLlzzpz.PrintSetFoot "制作单位:" + GetEnterpriseName(""), "", "打印日期:" + glo.sOperateDate
cLlzzpz.PrintSetHead "", "", "总&S页 第&P页"
cLlzzpz.SetRows m_mFg.Rows + 3, 0
cLlzzpz.SetCols m_mFg.Cols + 2, 0
'第一行
cLlzzpz.s 1, 1, 0, sTitle
cLlzzpz.SetCellAlign 1, 1, 0, 32 + 4
cLlzzpz.SetCellFontStyle 1, 1, 0, 2
cLlzzpz.MergeCells 1, 1, cLlzzpz.GetCols(0) - 1, 1
cLlzzpz.SetCellFontSize 1, 1, 0, 16
cLlzzpz.SetRowHeight 1, 28, 1, 0
'第二行
cLlzzpz.s 1, 2, 0, glo.sOperateYear + "年"
' cLlzzpz.SetCellFontStyle 1, 2, 0, 2
cLlzzpz.SetCellAlign 1, 2, 0, 32 + 4
cLlzzpz.MergeCells 1, 2, cLlzzpz.GetCols(0) - 1, 2
'划线
cLlzzpz.DrawGridLine 1, 3, m_mFg.Cols, m_mFg.Rows + 2, 0, 2, 0
'设置列宽
For cc = 0 To m_mFg.Cols - 1
cLlzzpz.SetColWidth 1, m_mFg.ColWidth(cc) / 13, cc + 1, 0
cLlzzpz.SetCellAlign cc + 1, 3, 0, 32 + 4
Next cc
For rr = 0 To m_mFg.Rows - 1
For cc = 0 To m_mFg.Cols - 1
cLlzzpz.s cc + 1, rr + 3, 0, Trim(m_mFg.TextMatrix(rr, cc))
Next cc
Next rr
cLlzzpz.PrintPreview 1, 0
cLlzzpz.SaveFile App.Path & "\CellFiles\ZzpzSet.cll", 0
End Sub
Private Function GetMyQC(str1 As String, str2 As String, str3 As String, str4 As String) '取期初
GetMyQC = 1
End Function
Private Function GetMyQM(str1 As String, str2 As String, str3 As String, str4 As String) '取期末
GetMyQM = 1
End Function
Private Function GetMyFS(str1 As String, str2 As String, str3 As String, str4 As String) '取发生
GetMyFS = 1
End Function
Private Function GetMyLFS(str1 As String, str2 As String, str3 As String, str4 As String) '取累计发生
GetMyLFS = 1
End Function
Private Function GetMyJFS(str1 As String, str2 As String, str3 As String, str4 As String) '取累计发生
GetMyJFS = 1
End Function
Private Sub cLlZzpz_CalcFunc(ByVal Name As String, ByVal rettype As Long, ByVal paranum As Long)
Dim bVoid As Variant
Dim vArgu As Variant, aryvArgu() As Variant
Dim i As Integer
Dim RESULTSTR As String
Dim cTmp As String
'取得各个参数
bFormulaErr = False
ReDim aryvArgu(1 To paranum)
For i = 1 To paranum
aryvArgu(i) = CStr(cLlzzpz.GetFuncStringPara(i - 1, paranum))
Next i
Select Case UCase$(Name)
Case "QC", "QM", "FS", "LFS", "JFS", "QCN", "QMN", "FSN", _
"LFSN", "JFSN", "QCW", "QMW", "FSW", "LFSW", "JFSW" 'KM,QJ,FS
If aryvArgu(1) = "" Then
MsgBox "自定义公式" & UCase$(Name) & "的第一参数不能为空！", vbExclamation, "提示"
bFormulaErr = True
Exit Sub
End If
Select Case aryvArgu(2)
Case "年", "月"
Case Else
MsgBox "自定义公式" & UCase$(Name) & "的第二参数不正确,只能为年或月！", vbExclamation, "提示"
bFormulaErr = True
Exit Sub
End Select
Select Case aryvArgu(3)
Case "借", "贷"
Case Else
MsgBox "自定义公式" & UCase$(Name) & "的第三参数不正确，只能为借或贷！", vbExclamation, "提示"
bFormulaErr = True
Exit Sub
End Select
If Not CheckIsCZ("tzw_km" & glo.sOperateYear, "kmdm", aryvArgu(1)) Then
MsgBox "自定义公式" & UCase$(Name) & "的第一参数不正确，不存在此科目！", vbExclamation, "提示"
bFormulaErr = True
Exit Sub
End If
If Trim$(aryvArgu(4)) = "" Then
Else
If Not CheckIsCZ("tUSU_Department" + glo.sOperateYear, "cDepCode", aryvArgu(4)) Then
MsgBox "自定义公式" & UCase$(Name) & "的第四参数不正确，不存在此部门！", vbExclamation, "提示"
bFormulaErr = True
Exit Sub
End If
End If
If Trim$(aryvArgu(5)) = "" Then
Else
If Not CheckIsCZ("tZW_Item" + glo.sOperateYear, "cCode", aryvArgu(5)) Then
MsgBox "自定义公式" & UCase$(Name) & "的第五参数不正确，不存在此项目！", vbExclamation, "提示"
bFormulaErr = True
Exit Sub
End If
End If
Select Case UCase$(Name) '不需要具体计算值
Case "QC"
RESULTSTR = "&&" & str(GetMyQC(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), ""))
Case "QM"
RESULTSTR = "&&" & str(GetMyQM(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), ""))
Case "FS"
RESULTSTR = "&&" & str(GetMyFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), ""))
Case "LFS"
RESULTSTR = "&&" & str(GetMyLFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), ""))
Case "JFS"
RESULTSTR = "&&" & str(GetMyJFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), ""))
Case "DFHJ"
RESULTSTR = ""
Case "JFHJ"
RESULTSTR = ""
'-------------------------------------------------------------------
Case "QCN"
RESULTSTR = "&&" & str(GetMyQC(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "SL"))
Case "QMN"
RESULTSTR = "&&" & str(GetMyQM(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "SL"))
Case "FSN"
RESULTSTR = "&&" & str(GetMyFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "SL"))
Case "LFSN"
RESULTSTR = "&&" & str(GetMyLFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "SL"))
Case "JFSN"
RESULTSTR = "&&" & str(GetMyJFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "SL"))
'-------------------------------------------------------------------
Case "QCW"
RESULTSTR = "&&" & str(GetMyQC(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "WB"))
Case "QMW"
RESULTSTR = "&&" & str(GetMyQM(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "WB"))
Case "FSW"
RESULTSTR = "&&" & str(GetMyFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "WB"))
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -