企业管理

开发平台：

Visual Basic

：源码内容

.m_biaoge.Enabled = True
.m_windows.Enabled = True
If Xtczybm <> "000" And Me.ml_edit_lx = 1 And Edit_Flag = False Then '判断是否管理员并设置菜单
.m_edit.Visible = False
.m_view.Visible = False
.m_biaoge.Visible = False
.m_page.Visible = False
.m_data.Visible = False
.m_manage.Visible = False
.m_windows.Visible = False
Else
.m_edit.Visible = True
.m_view.Visible = True
.m_biaoge.Visible = True
.m_page.Visible = True
.m_data.Visible = True
.m_manage.Visible = True
.m_windows.Visible = True
End If
End If
End With
End Sub
Private Sub mf_settoolbar(ByVal ll_count As Long)
With MDI_frame
If ll_count = 0 Then
.CoolBar2.Visible = False
.CoolBar3.Visible = False
For i = 3 To 33
.Toolbar1.Buttons(i).Visible = False
Next i
.Toolbar1.Buttons(3).Visible = False
End If
If ll_count = 1 Then
.CoolBar2.Visible = True
.CoolBar3.Visible = True
.CoolBar1.Top = 0
.CoolBar2.Top = 390
.CoolBar3.Top = 780
For i = 3 To 33
.Toolbar1.Buttons(i).Visible = True
Next i
For i = 1 To 24
.Toolbar2.Buttons(i).Visible = True
Next i
For i = 1 To 23
.Toolbar3.Buttons(i).Visible = True
Next i
If Xtczybm = "000" Then
For i = 16 To 23
.Toolbar1.Buttons(i).Visible = False
Next i
If Me.ml_edit_lx = 1 Then
Me.Cell1.GridReadOnly = True
Me.Cell1.TopLabelVisible = False
Me.Cell1.SideLabelVisible = False
Else
Me.Cell1.GridReadOnly = False
Me.Cell1.TopLabelVisible = True
Me.Cell1.SideLabelVisible = True
End If
Else
.Toolbar1.Buttons(16).Visible = False
.Toolbar1.Buttons(17).Visible = False
.Toolbar1.Buttons(18).Visible = False
If Me.ml_edit_lx = 1 Then
Me.Cell1.TopLabelVisible = False
Me.Cell1.SideLabelVisible = False
Else
Me.Cell1.TopLabelVisible = True
Me.Cell1.SideLabelVisible = True
End If
If Me.ml_edit_lx = 1 Or Me.ml_edit_lx = 4 Or Me.ml_edit_lx = 7 Then
If Edit_Flag = False Then
.CoolBar2.Visible = False
.CoolBar3.Visible = False
For i = 7 To 33
.Toolbar1.Buttons(i).Visible = False
Next i
For i = 1 To 24
.Toolbar2.Buttons(i).Visible = False
Next i
For i = 1 To 23
.Toolbar3.Buttons(i).Visible = False
Next i
Else
For i = 14 To 20
.Toolbar2.Buttons(i).Visible = False
Next i
For i = 15 To 33
.Toolbar1.Buttons(i).Visible = False
Next i
.Toolbar1.Buttons(30).Visible = True
End If
Else
If Me.ml_edit_lx = 6 Or Me.ml_edit_lx = 3 Then '是否是文件是文件是菜单可用
For i = 24 To 33
.Toolbar1.Buttons(i).Visible = True
Next i
For i = 14 To 20
.Toolbar2.Buttons(i).Visible = True
Next i
Else
For i = 24 To 33
.Toolbar1.Buttons(i).Visible = False
Next i
For i = 14 To 20
.Toolbar2.Buttons(i).Visible = False
Next i
End If
End If
End If
End If
End With
End Sub
Private Sub Cell1_OnCellChange(ByVal oldcol As Long, ByVal oldrow As Long, ByVal newcol As Long, ByVal newrow As Long)
Dim ls_note As String, ll_backcolor, ll_forecolor, ls_data As String, ls_data1
If Cell1.IsFormulaCell(ml_col, ml_row) Then
ls_note = Cell1.DoGetCellNote(ml_col, ml_row)
Cell1.DoGetCellColor ml_col, ml_row, ll_forecolor, ll_backcolor
If MDI_frame.m_backcolor.Checked = True Then
If Left(ls_note, 1) = "1" Then
Cell1.DoSetCellColor ml_col, ml_row, ll_forecolor, RGB(0, 128, 128)
Else
Cell1.DoSetCellColor ml_col, ml_row, ll_forecolor, RGB(255, 0, 255)
End If
End If
End If
If Cell1.DoGetCellNote(ml_col, ml_row) = "转换1" Then
Cell1.DoGetCellData ml_col, ml_row, ls_data1
If IsNumeric(ls_data1) Then
ls_data = cell_zhdx1(ls_data1)
Cell1.DoSetCellData ml_col, ml_row, ls_data
End If
End If
If Cell1.DoGetCellNote(ml_col, ml_row) = "转换2" Then
Cell1.DoGetCellData ml_col, ml_row, ls_data1
If IsNumeric(ls_data1) Then
ls_data = cell_zhdx2(ls_data1)
Cell1.DoSetCellData ml_col, ml_row, ls_data
End If
End If
If Cell1.DoGetCellNote(ml_col, ml_row) = "转换3" Then
Cell1.DoGetCellData ml_col, ml_row, ls_data1
If IsNumeric(ls_data1) Then
ls_data = cell_zhdx3(ls_data1)
Cell1.DoSetCellData ml_col, ml_row, ls_data
End If
End If
Dim aa, j, i '定义必要的变量
'得到数据并去掉数据中的","
If Cell1.DoGetCellData(ml_col, ml_row, aa) = True Then aa = deleteword(aa, ",")
j = 0
'检查数据
For i = 1 To Len(aa)
If j > 1 Then
Cell1.DoUndo
MsgBox "输入数据不对!" & vbCrLf & "修改被取消", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
Exit For
End If
If Not IsNumeric(Mid(aa, i, 1)) And Mid(aa, i, 1) <> "." Then Exit For
If Mid(aa, i, 1) = "." Then
j = j + 1
End If
Next i
Cell1.DoRedrawAll
'''''''''''''''''''
ml_col = newcol
ml_row = newrow
Cell1.DoClearSelection
Cell1.DoSelectRange ml_col, ml_row, ml_col, ml_row
MDI_frame.mb_setfont = False
mf_cell_toolbar '设置与当前单元相关的工具栏状态
MDI_frame.mb_setfont = True
End Sub
'执行用户自定义函数
Private Sub Cell1_OnExecuteUserFunc(ByVal Name As String, ByVal rettype As Integer, ByVal paranum As Integer, paratype As Long, funcResult As Variant)
Dim strQueryResult As String
Dim strOptional As String
Dim la_paravar() As Variant
Dim ls_select As String
ReDim la_paravar(paranum) As Variant
Dim i As Long
Dim lrst_all As ADODB.Recordset
Dim ls_year As String, ls_month As String
Dim ls_YearName As String, ls_MonthName As String
Dim ls_SQLselect As String
Dim ls_row As Integer, ls_col As Integer
Dim iInstr1, iInstr2
Dim tStr As String
Dim sqlstring As Variant
Dim prodata As Double '中间数据
Dim proline As String
On Error GoTo err_msg
strOptional = ""
For i = 0 To paranum - 1
la_paravar(i) = Cell1.DoFetchFuncParameter2(i)
Next
'处理自定义函数
Select Case LCase(Name)
Case "je_ncye", "je_qcye", "je_qmye", "je_bqjfs", "je_bqdfs", "je_ljjfs", "je_ljdfs", "je_njfse", "je_yjfse"
ls_year = mf_exchange_nyr(la_paravar(1))
ls_month = mf_exchange_nyr(la_paravar(2))
'年月日合法性检查
If mf_check_nyr(ls_year, ls_month) Then funcResult = CVErr(funcResult): Exit Sub
'查询字符串赋值
If la_paravar(3) = "" Then '辅助项1参数为空时
Select Case LCase(Name)
Case "je_ncye"
ls_SQLselect = "SELECT ycye from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "je_qcye"
ls_SQLselect = "SELECT qcye from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "je_qmye"
ls_SQLselect = "SELECT qmye from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "je_bqjfs"
ls_SQLselect = "SELECT mjje from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "je_bqdfs"
ls_SQLselect = "SELECT mdje from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "je_ljjfs"
ls_SQLselect = "SELECT byjfljje from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "je_ljdfs"
ls_SQLselect = "SELECT bydfljje from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "je_njfse"
ls_SQLselect = "SELECT byjfljje-bydfljje from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "je_yjfse"
ls_SQLselect = "SELECT mjje-mdje from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
End Select
Else '辅助项1参数不为空时
'检查辅助项1参数合法性
iInstr1 = UCase(Left(la_paravar(3), 1))
If iInstr1 = "P" Or iInstr1 = "D" Or iInstr1 = "C" Or iInstr1 = "I" Or iInstr1 = "J" Or iInstr1 = "S" Then
Else
GoTo err_msg
End If
iInstr2 = Right(la_paravar(3), Len(la_paravar(3)) - 1)
Select Case iInstr1
Case "P"
tStr = "and PersonCode ='" & iInstr2 & "'"
Case "D"
tStr = "and DeptCode ='" & iInstr2 & "'"
Case "C"
tStr = "and CusCode ='" & iInstr2 & "'"
Case "I"
tStr = "and ItemClassCode ='" & iInstr2 & "'"
Case "J"
tStr = "and ItemCode ='" & iInstr2 & "'"
Case "S"
tStr = "and Supplier_Code ='" & iInstr2 & "'"
End Select
If la_paravar(4) <> "" Then '辅助项2参数不为空时
'检查辅助项2参数合法性
iInstr1 = UCase(Left(la_paravar(4), 1))
If iInstr1 = "P" Or iInstr1 = "D" Or iInstr1 = "C" Or iInstr1 = "I" Or iInstr1 = "J" Or iInstr1 = "S" Or iInstr1 = "*" Or iInstr1 = "#" Then
Else
GoTo err_msg
End If
iInstr2 = Right(la_paravar(4), Len(la_paravar(4)) - 1)
Select Case iInstr1
Case "P"
tStr = tStr + "and PersonCode ='" & iInstr2 & "'"
Case "D"
tStr = tStr + "and DeptCode ='" & iInstr2 & "'"
Case "C"
tStr = tStr + "and CusCode ='" & iInstr2 & "'"
Case "I"
tStr = tStr + "and ItemClassCode ='" & iInstr2 & "'"
Case "J"
tStr = tStr + "and ItemCode ='" & iInstr2 & "'"
Case "S"
tStr = "and Supplier_Code ='" & iInstr2 & "'"
End Select
End If
If iInstr1 = "*" Then '辅助项2参数为*时
Select Case LCase(Name)
Case "je_ncye"
ls_SQLselect = "SELECT sum(ycye) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_qcye"
ls_SQLselect = "SELECT sum(qcye) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_qmye"
ls_SQLselect = "SELECT sum(qmye) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_bqjfs"
ls_SQLselect = "SELECT sum(mjje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_bqdfs"
ls_SQLselect = "SELECT sum(mdje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_ljjfs"
ls_SQLselect = "SELECT sum(byjfljje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_ljdfs"
ls_SQLselect = "SELECT sum(bydfljje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_njfse"
ls_SQLselect = "SELECT sum(byjfljje)-sum(bydfljje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_yjfse"
ls_SQLselect = "SELECT sum(mjje)-sum(mdje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
End Select
Else '辅助项2参数不为*时
If iInstr1 = "#" Then '辅助项2参数为#时
Select Case LCase(Name)
Case "je_ncye"
ls_SQLselect = "SELECT sum(ycye) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND substring(ccode,1," & Len(Trim(la_paravar(0))) & ") = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_qcye"
ls_SQLselect = "SELECT sum(qcye) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND substring(ccode,1," & Len(Trim(la_paravar(0))) & ") = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_qmye"
ls_SQLselect = "SELECT sum(qmye) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND substring(ccode,1," & Len(Trim(la_paravar(0))) & ") = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_bqjfs"
ls_SQLselect = "SELECT sum(mjje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND substring(ccode,1," & Len(Trim(la_paravar(0))) & ") = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_bqdfs"
ls_SQLselect = "SELECT sum(mdje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND substring(ccode,1," & Len(Trim(la_paravar(0))) & ") = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_ljjfs"
ls_SQLselect = "SELECT sum(byjfljje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND substring(ccode,1," & Len(Trim(la_paravar(0))) & ") = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_ljdfs"
ls_SQLselect = "SELECT sum(bydfljje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND substring(ccode,1," & Len(Trim(la_paravar(0))) & ") = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_njfse"
ls_SQLselect = "SELECT sum(byjfljje)-sum(bydfljje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND substring(ccode,1," & Len(Trim(la_paravar(0))) & ") = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_yjfse"
ls_SQLselect = "SELECT sum(mjje)-sum(mdje) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND substring(ccode,1," & Len(Trim(la_paravar(0))) & ") = '" & Trim(la_paravar(0)) & "' " & tStr & " "
End Select
Else '辅助项2参数不为*#时
Select Case LCase(Name)
Case "je_ncye"
ls_SQLselect = "SELECT ycye from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_qcye"
ls_SQLselect = "SELECT qcye from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_qmye"
ls_SQLselect = "SELECT qmye from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_bqjfs"
ls_SQLselect = "SELECT mjje from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_bqdfs"
ls_SQLselect = "SELECT mdje from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_ljjfs"
ls_SQLselect = "SELECT byjfljje from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_ljdfs"
ls_SQLselect = "SELECT bydfljje from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_njfse"
ls_SQLselect = "SELECT byjfljje-bydfljje from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "je_yjfse"
ls_SQLselect = "SELECT mjje-mdje from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
End Select
End If
End If
End If
Set lrst_all = New ADODB.Recordset
lrst_all.CursorLocation = adUseClient
lrst_all.CursorType = adOpenKeyset
lrst_all.LockType = adLockBatchOptimistic
lrst_all.Open ls_SQLselect, Cw_DataEnvi.dataconnect
If lrst_all.RecordCount > 0 Then
lrst_all.MoveFirst
funcResult = lrst_all.Fields(0).Value
Else
funcResult = 0
End If
lrst_all.Close
Set lrst_all = Nothing
'处理财务数量数据
Case "sl_nc", "sl_qc", "sl_qm", "sl_bqjf", "sl_bqdf", "sl_ljjf", "sl_ljdf", "sl_njfs", "sl_yjfs"
ls_year = mf_exchange_nyr(la_paravar(1))
ls_month = mf_exchange_nyr(la_paravar(2))
'年月日合法性检查
If mf_check_nyr(ls_year, ls_month) Then funcResult = CVErr(funcResult): Exit Sub
'查询字符串赋值
If la_paravar(3) = "" Then '辅助项1参数为空时
Select Case LCase(Name)
Case "sl_nc"
ls_SQLselect = "SELECT ycsl from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "sl_qc"
ls_SQLselect = "SELECT qcsl from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "sl_qm"
ls_SQLselect = "SELECT qmsl from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "sl_bqjf"
ls_SQLselect = "SELECT mjsl from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "sl_bqdf"
ls_SQLselect = "SELECT mdsl from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "sl_ljjf"
ls_SQLselect = "SELECT byjfljsl from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "sl_ljdf"
ls_SQLselect = "SELECT bydfljsl from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "sl_njfs"
ls_SQLselect = "SELECT byjfljsl-bydfljsl from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "sl_yjfs"
ls_SQLselect = "SELECT mjsl-mdsl from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
End Select
Else '辅助项1参数不为空时
'检查辅助项1参数合法性
iInstr1 = UCase(Left(la_paravar(3), 1))
If iInstr1 = "P" Or iInstr1 = "D" Or iInstr1 = "C" Or iInstr1 = "I" Or iInstr1 = "J" Or iInstr1 = "S" Then
Else
GoTo err_msg
End If
iInstr2 = Right(la_paravar(3), Len(la_paravar(3)) - 1)
Select Case iInstr1
Case "P"
tStr = "and PersonCode ='" & iInstr2 & "'"
Case "D"
tStr = "and DeptCode ='" & iInstr2 & "'"
Case "C"
tStr = "and CusCode ='" & iInstr2 & "'"
Case "I"
tStr = "and ItemClassCode ='" & iInstr2 & "'"
Case "J"
tStr = "and ItemCode ='" & iInstr2 & "'"
Case "S"
tStr = "and Supplier_Code ='" & iInstr2 & "'"
End Select
If la_paravar(4) <> "" Then '辅助项2参数不为空时
'检查辅助项2参数合法性
iInstr1 = UCase(Left(la_paravar(4), 1))
If iInstr1 = "P" Or iInstr1 = "D" Or iInstr1 = "C" Or iInstr1 = "I" Or iInstr1 = "J" Or iInstr1 = "S" Or iInstr1 = "*" Then
Else
GoTo err_msg
End If
iInstr2 = Right(la_paravar(4), Len(la_paravar(4)) - 1)
Select Case iInstr1
Case "P"
tStr = tStr + "and PersonCode ='" & iInstr2 & "'"
Case "D"
tStr = tStr + "and DeptCode ='" & iInstr2 & "'"
Case "C"
tStr = tStr + "and CusCode ='" & iInstr2 & "'"
Case "I"
tStr = tStr + "and ItemClassCode ='" & iInstr2 & "'"
Case "J"
tStr = tStr + "and ItemCode ='" & iInstr2 & "'"
Case "S"
tStr = "and Supplier_Code ='" & iInstr2 & "'"
End Select
End If
If iInstr1 = "*" Then '辅助项2参数为*时
Select Case LCase(Name)
Case "sl_nc"
ls_SQLselect = "SELECT sum(ycsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_qc"
ls_SQLselect = "SELECT sum(qcsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_qm"
ls_SQLselect = "SELECT sum(qmsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_bqjf"
ls_SQLselect = "SELECT sum(mjsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_bqdf"
ls_SQLselect = "SELECT sum(mdsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_ljjf"
ls_SQLselect = "SELECT sum(byjfljsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_ljdf"
ls_SQLselect = "SELECT sum(bydfljsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_njfs"
ls_SQLselect = "SELECT sum(byjfljsl)-sum(bydfljsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_yjfs"
ls_SQLselect = "SELECT sum(mjsl)-sum(mdsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
End Select
Else '辅助项2参数不为*时
Select Case LCase(Name)
Case "sl_nc"
ls_SQLselect = "SELECT ycsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_qc"
ls_SQLselect = "SELECT qcsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_qm"
ls_SQLselect = "SELECT qmsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_bqjf"
ls_SQLselect = "SELECT mjsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_bqdf"
ls_SQLselect = "SELECT mdsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_ljjf"
ls_SQLselect = "SELECT byjfljsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_ljdf"
ls_SQLselect = "SELECT bydfljsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_njfs"
ls_SQLselect = "SELECT byjfljsl-bydfljsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "sl_yjfs"
ls_SQLselect = "SELECT mjsl-mdsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
End Select
End If
End If
Set lrst_all = New ADODB.Recordset
lrst_all.CursorLocation = adUseClient
lrst_all.CursorType = adOpenKeyset
lrst_all.LockType = adLockBatchOptimistic
lrst_all.Open ls_SQLselect, Cw_DataEnvi.dataconnect
If lrst_all.RecordCount > 0 Then
lrst_all.MoveFirst
funcResult = lrst_all.Fields(0).Value
Else
funcResult = 0
End If
lrst_all.Close
Set lrst_all = Nothing
'处理财务外币数据
Case "wb_nc", "wb_qc", "wb_qm", "wb_bqjf", "wb_bqdf", "wb_ljjf", "wb_ljdf", "wb_njfs", "wb_yjfs"
ls_year = mf_exchange_nyr(la_paravar(1))
ls_month = mf_exchange_nyr(la_paravar(2))
'年月日合法性检查
If mf_check_nyr(ls_year, ls_month) Then funcResult = CVErr(funcResult): Exit Sub
'查询字符串赋值
If la_paravar(3) = "" Then '辅助项1参数为空时
Select Case LCase(Name)
Case "wb_nc"
ls_SQLselect = "SELECT ycwb from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "wb_qc"
ls_SQLselect = "SELECT qcwb from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "wb_qm"
ls_SQLselect = "SELECT qmwb from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "wb_bqjf"
ls_SQLselect = "SELECT mjwb from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "wb_bqdf"
ls_SQLselect = "SELECT mdwb from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "wb_ljjf"
ls_SQLselect = "SELECT byjfljwb from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "wb_ljdf"
ls_SQLselect = "SELECT bydfljwb from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "wb_njfs"
ls_SQLselect = "SELECT byjfljwb-bydfljwb from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
Case "wb_yjfs"
ls_SQLselect = "SELECT mjwb-mdwb from cwzz_accsum WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "'"
End Select
Else '辅助项1参数不为空时
'检查辅助项1参数合法性
iInstr1 = UCase(Left(la_paravar(3), 1))
If iInstr1 = "P" Or iInstr1 = "D" Or iInstr1 = "C" Or iInstr1 = "I" Or iInstr1 = "J" Or iInstr1 = "S" Then
Else
GoTo err_msg
End If
iInstr2 = Right(la_paravar(3), Len(la_paravar(3)) - 1)
Select Case iInstr1
Case "P"
tStr = "and PersonCode ='" & iInstr2 & "'"
Case "D"
tStr = "and DeptCode ='" & iInstr2 & "'"
Case "C"
tStr = "and CusCode ='" & iInstr2 & "'"
Case "I"
tStr = "and ItemClassCode ='" & iInstr2 & "'"
Case "J"
tStr = "and ItemCode ='" & iInstr2 & "'"
Case "S"
tStr = "and Supplier_Code ='" & iInstr2 & "'"
End Select
If la_paravar(4) <> "" Then '辅助项2参数不为空时
'检查辅助项2参数合法性
iInstr1 = UCase(Left(la_paravar(4), 1))
If iInstr1 = "P" Or iInstr1 = "D" Or iInstr1 = "C" Or iInstr1 = "I" Or iInstr1 = "J" Or iInstr1 = "S" Or iInstr1 = "*" Then
Else
GoTo err_msg
End If
iInstr2 = Right(la_paravar(4), Len(la_paravar(4)) - 1)
Select Case iInstr1
Case "P"
tStr = tStr + "and PersonCode ='" & iInstr2 & "'"
Case "D"
tStr = tStr + "and DeptCode ='" & iInstr2 & "'"
Case "C"
tStr = tStr + "and CusCode ='" & iInstr2 & "'"
Case "I"
tStr = tStr + "and ItemClassCode ='" & iInstr2 & "'"
Case "J"
tStr = tStr + "and ItemCode ='" & iInstr2 & "'"
Case "S"
tStr = "and Supplier_Code ='" & iInstr2 & "'"
End Select
End If
If iInstr1 = "*" Then '辅助项2参数为*时
Select Case LCase(Name)
Case "wb_nc"
ls_SQLselect = "SELECT sum(ycwb) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_qc"
ls_SQLselect = "SELECT sum(qcwb) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_qm"
ls_SQLselect = "SELECT sum(qmwb) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_bqjf"
ls_SQLselect = "SELECT sum(mjwb) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_bqdf"
ls_SQLselect = "SELECT sum(mdwb) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_ljjf"
ls_SQLselect = "SELECT sum(byjfljwb) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_ljdf"
ls_SQLselect = "SELECT sum(bydfljwb) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_njfs"
ls_SQLselect = "SELECT sum(byjfljwb)-sum(bydfljwb) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_yjfs"
ls_SQLselect = "SELECT sum(mjwb)-sum(mdwb) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
End Select
Else '辅助项2参数不为*时
Select Case LCase(Name)
Case "wb_nc"
ls_SQLselect = "SELECT ycwb from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_qc"
ls_SQLselect = "SELECT qcwb from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_qm"
ls_SQLselect = "SELECT qmwb from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_bqjf"
ls_SQLselect = "SELECT mjwb from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_bqdf"
ls_SQLselect = "SELECT mdwb from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_ljjf"
ls_SQLselect = "SELECT byjfljwb from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_ljdf"
ls_SQLselect = "SELECT bydfljwb from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_njfs"
ls_SQLselect = "SELECT byjfljwb-bydfljwb from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "wb_yjfs"
ls_SQLselect = "SELECT mjwb-mdwb from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
End Select
End If
End If
Set lrst_all = New ADODB.Recordset
lrst_all.CursorLocation = adUseClient
lrst_all.CursorType = adOpenKeyset
lrst_all.LockType = adLockBatchOptimistic
lrst_all.Open ls_SQLselect, Cw_DataEnvi.dataconnect
If lrst_all.RecordCount > 0 Then
lrst_all.MoveFirst
funcResult = lrst_all.Fields(0).Value
Else
funcResult = 0
End If
lrst_all.Close
Set lrst_all = Nothing
'处理辅助核算帐中项目数量数据
Case "xmsl_bqjf", "xmsl_bqdf", "xmsl_ljjf", "xmsl_ljdf"
ls_year = mf_exchange_nyr(la_paravar(1))
ls_month = mf_exchange_nyr(la_paravar(2))
'年月日合法性检查
If mf_check_nyr(ls_year, ls_month) Then funcResult = CVErr(funcResult): Exit Sub
'查询字符串赋值
If la_paravar(3) = "" Then '辅助项1参数为空时
GoTo err_msg
Else '辅助项1参数不为空时
'检查辅助项1参数合法性
iInstr1 = UCase(Left(la_paravar(3), 1))
If iInstr1 = "P" Or iInstr1 = "D" Or iInstr1 = "C" Or iInstr1 = "I" Or iInstr1 = "J" Or iInstr1 = "S" Then
Else
GoTo err_msg
End If
iInstr2 = Right(la_paravar(3), Len(la_paravar(3)) - 1)
Select Case iInstr1
Case "P"
tStr = "and PersonCode ='" & iInstr2 & "'"
Case "D"
tStr = "and DeptCode ='" & iInstr2 & "'"
Case "C"
tStr = "and CusCode ='" & iInstr2 & "'"
Case "I"
tStr = "and ItemClassCode ='" & iInstr2 & "'"
Case "J"
tStr = "and ItemCode ='" & iInstr2 & "'"
Case "S"
tStr = "and Supplier_Code ='" & iInstr2 & "'"
End Select
If la_paravar(4) <> "" Then '辅助项2参数不为空时
'检查辅助项2参数合法性
iInstr1 = UCase(Left(la_paravar(4), 1))
If iInstr1 = "P" Or iInstr1 = "D" Or iInstr1 = "C" Or iInstr1 = "I" Or iInstr1 = "J" Or iInstr1 = "S" Or iInstr1 = "*" Then
Else
GoTo err_msg
End If
iInstr2 = Right(la_paravar(4), Len(la_paravar(4)) - 1)
Select Case iInstr1
Case "P"
tStr = tStr + "and PersonCode ='" & iInstr2 & "'"
Case "D"
tStr = tStr + "and DeptCode ='" & iInstr2 & "'"
Case "C"
tStr = tStr + "and CusCode ='" & iInstr2 & "'"
Case "I"
tStr = tStr + "and ItemClassCode ='" & iInstr2 & "'"
Case "J"
tStr = tStr + "and ItemCode ='" & iInstr2 & "'"
Case "S"
tStr = "and Supplier_Code ='" & iInstr2 & "'"
End Select
End If
If iInstr1 = "*" Then '辅助项2参数为*时
Select Case LCase(Name)
Case "xmsl_bqjf"
ls_SQLselect = "SELECT sum(ItemMjsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "xmsl_bqdf"
ls_SQLselect = "SELECT sum(ItemMdsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "xmsl_ljjf"
ls_SQLselect = "SELECT sum(ItemByljjfsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "xmsl_ljdf"
ls_SQLselect = "SELECT sum(ItemByljdfsl) from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
End Select
Else '辅助项2参数不为*时
Select Case LCase(Name)
Case "xmsl_bqjf"
ls_SQLselect = "SELECT ItemMjsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "xmsl_bqdf"
ls_SQLselect = "SELECT ItemMdsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "xmsl_ljjf"
ls_SQLselect = "SELECT ItemByljjfsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
Case "xmsl_ljdf"
ls_SQLselect = "SELECT ItemByljdfsl from cwzz_accsumassi WHERE year =" & ls_year & " and period= " & ls_month & " AND ccode = '" & Trim(la_paravar(0)) & "' " & tStr & " "
End Select
End If
End If
Set lrst_all = New ADODB.Recordset
lrst_all.CursorLocation = adUseClient
lrst_all.CursorType = adOpenKeyset
lrst_all.LockType = adLockBatchOptimistic
lrst_all.Open ls_SQLselect, Cw_DataEnvi.dataconnect
If lrst_all.RecordCount > 0 Then
lrst_all.MoveFirst
funcResult = lrst_all.Fields(0).Value
Else
funcResult = 0
End If
lrst_all.Close
Set lrst_all = Nothing
Case "date_y"
'***************************************************
If MDI_frame.ml_new_lx = 1 Then
funcResult = Year(Xtrq) & "年"
Else
'***********************************************
funcResult = la_paravar(0) & "年"
End If
Case "date_m"
'***************************************************
If MDI_frame.ml_new_lx = 1 Then
funcResult = Month(Xtrq) & "月"
Else
'***********************************************
funcResult = la_paravar(0) & "月"
End If
Case "date_d"
'***************************************************
If MDI_frame.ml_new_lx = 1 Then
funcResult = Day(Xtrq) & "日"
Else
'***********************************************
funcResult = la_paravar(0) & "日"
End If
Case "getdatafpage"
Cell1.DoGetPageCellData Val(la_paravar(2)) - 1, Val(la_paravar(1)) - 1, Val(la_paravar(0)) - 1, funcResult
Case "enterprise"
funcResult = "编制单位: " & Xtdwm
Case "operator"
funcResult = "操作员: " & Xtczy
Case "read_data"
Dim 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
Dim ls_ny As String
MDI_frame.m_recompute.Enabled = False
If la_paravar(2) = "" Or la_paravar(3) = "" Then '年?月参数为空判断
MsgBox "年或月参数不能为空!"
funcResult = CVErr(funcResult)
Exit Sub
Else '年?月参数均不为空
ls_year = mf_exchange_nyr(la_paravar(2)) '年月转换
ls_month = mf_exchange_nyr(la_paravar(3))
'年月日有效性校验
If mf_check_nyr(ls_year, ls_month) Then funcResult = CVErr(funcResult): Exit Sub
End If
ls_ny = ls_year & "-" & ls_month
Set lrst_open = New ADODB.Recordset
ls_select = "select report_nr from dzbb_bb where system_code='" & Trim(la_paravar(0)) _
& "' and report_model_id='" & Trim(la_paravar(1)) _
& "' and report_time='" & ls_ny & "'"
lrst_open.Open ls_select, Cw_DataEnvi.dataconnect, adOpenDynamic, adLockOptimistic, adCmdText
If lrst_open.EOF = True Then
MsgBox Trim(la_paravar(0)) & "系统" & Trim(la_paravar(1)) & "报表" & ls_ny & "年月数据不存在!"
funcResult = CVErr(funcResult)
lrst_open.Close
Set lrst_open = Nothing
Exit Sub
End If
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.DoAppendPageFromFile ls_filename, 0, 1
Cell1.DoSetPageLabel Cell1.DoGetTotalPages - 1, "基础数据页"
Kill ls_filename
lrst_open.Close
Set lrst_open = Nothing
Case "sql_odbc"
Dim temp_iia As Long, temp_jja As Long
Dim tcols As Variant, trows As Variant
Dim sqlstringa
temp_iia = 0
For i = 0 To Cell1.Rows - 1
For j = 0 To Cell1.Cols - 1
If Cell1.IsFormulaCell(j, i) = True Then
Cell1.DoGetFormula j, i, sqlstringa
If InStr(1, sqlstringa, la_paravar(0)) <> 0 Then
temp_iia = 1
Exit For
End If
End If
Next j
If temp_iia <> 0 Then
Exit For
End If
Next i
If temp_iia = 0 Then
i = Cell1.DoGetCurrentRow
temp_iia = i
temp_jja = Cell1.DoGetCurrentCol
Else
temp_iia = i
temp_jja = j
End If
Dim lqq_table As Variant
Dim con_str As String
con_str = "DSN=" & Trim(la_paravar(1)) & ";UID=" & la_paravar(2) & ";PWD=" & la_paravar(3) & ""
If Trim(la_paravar(1)) <> "" Then
If Cell1.DoOpenODBCDbase(con_str, lqq_table) = False Then Exit Sub
End If
Cell1.DoDumpDbaseData la_paravar(0), temp_jja, temp_iia + 1, 0, True, tcols, trows
'使用SQL语句查询
Case "sql_all"
Dim ret As New ADODB.Recordset
Dim temp_ii As Integer, temp_jj As Integer
Dim sum_data() As Double
temp_ii = 0
For i = 0 To Cell1.Rows - 1 '取得公式所在的行?列号
For j = 0 To Cell1.Cols - 1
If Cell1.IsFormulaCell(j, i) = True Then
Cell1.DoGetFormula j, i, sqlstring
If InStr(1, sqlstring, la_paravar(0)) <> 0 Then
temp_ii = 1
Exit For
End If
End If
Next j
If temp_ii <> 0 Then
Exit For
End If
Next i
If temp_ii = 0 Then
i = Cell1.DoGetCurrentRow
temp_ii = i
temp_jj = Cell1.DoGetCurrentCol
Else
temp_ii = i
temp_jj = j
End If
If la_paravar(1) = "" Then '年月字段名为空
ls_SQLselect = la_paravar(0)
Else '年月字段名不为空
ls_year = mf_exchange_nyr(la_paravar(2)) '年月转换
ls_month = mf_exchange_nyr(la_paravar(3))
'年月日有效性校验
If mf_check_nyr(ls_year, ls_month) Then funcResult = CVErr(funcResult): Exit Sub
iInstr1 = InStr(1, la_paravar(1), ",")
iInstr2 = InStr(1, la_paravar(1), "$")
If iInstr2 > 0 Then '去除la_paravar(1)中的"$"
la_paravar(1) = Left(la_paravar(1), Len(la_paravar(1)) - 1)
End If
If iInstr2 > 0 Then '数据库中年月字段为字符型
If iInstr1 > 0 Then '数据库中年月字段为两个字段
ls_YearName = Left(la_paravar(1), iInstr1 - 1)
ls_MonthName = Right(la_paravar(1), Len(la_paravar(1)) - iInstr1)
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & ls_YearName & " ='" & ls_year & "' and " & ls_MonthName & " = '" & ls_month & "'"
Else
ls_SQLselect = la_paravar(0) & " where " & ls_YearName & " ='" & ls_year & "' and " & ls_MonthName & "= '" & ls_month & "'"
End If
Else
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & la_paravar(1) & " ='" & ls_year & "-" & ls_month & "'"
Else
ls_SQLselect = la_paravar(0) & " where " & la_paravar(1) & " ='" & ls_year & "-" & ls_month & "'"
End If
End If
Else '数据库中年月字段为数字型
If iInstr1 > 0 Then '数据库中年月字段为两个字段
ls_YearName = Left(la_paravar(1), iInstr1 - 1)
ls_MonthName = Right(la_paravar(1), Len(la_paravar(1)) - iInstr1)
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & ls_YearName & " =" & CInt(ls_year) & " and " & ls_MonthName & " = " & CInt(ls_month) & ""
Else
ls_SQLselect = la_paravar(0) & " where " & ls_YearName & " =" & CInt(ls_year) & " and " & ls_MonthName & "= " & CInt(ls_month) & ""
End If
Else
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & la_paravar(1) & " =" & CInt(ls_year) & "" & CInt(ls_month) & ""
Else
ls_SQLselect = la_paravar(0) & " where " & la_paravar(1) & " =" & CInt(ls_year) & "" & ls_month & ""
End If
End If
End If
End If
ret.Open ls_SQLselect, Cw_DataEnvi.dataconnect, adOpenKeyset, adLockPessimistic, 8
If ret.RecordCount = 0 Then
' MsgBox "表中无数据!"
Do While i < Cell1.Rows
For j = 0 To Cell1.Cols - 1
Cell1.DoSetCellData j, i, Empty
Cell1.DoClearLine j, i, j, i, 2
Cell1.DoClearLine j, i, j, i, 3
Cell1.DoClearLine j, i + 1, j, i + 1, 4
Next j
i = i + 1
Loop
Exit Sub
End If
If ret.RecordCount > 0 Then
If Cell1.Cols - j < ret.Fields.Count Then
Cell1.DoAppendCol ret.Fields.Count + j - Cell1.Cols
End If
If Cell1.Rows - i < ret.RecordCount + 1 Then
Cell1.DoAppendRow ret.RecordCount + i - Cell1.Rows + 2
End If
Cell1.DoDrawLine temp_jj, i, temp_jj, i, 2, 1, 0
ReDim sum_data(1, ret.Fields.Count)
If la_paravar(4) = "1" Then '画字段名
For j = 0 To ret.Fields.Count - 1
Cell1.DoDrawLine temp_jj + j, i, temp_jj + j, i, 4, 1, 0
Cell1.DoDrawLine temp_jj + j, i, temp_jj + j, i, 3, 1, 0
Cell1.DoSetCellData temp_jj + j, i, ret.Fields.Item(j).Name
Next j
Do While Not ret.EOF And i < Cell1.Rows - 1
Cell1.DoDrawLine temp_jj, i + 1, temp_jj, i + 1, 2, 1, 0
For j = 0 To ret.Fields.Count - 1
sqlstring = ret.Fields(ret.Fields.Item(j).Name)
If IsNumeric(sqlstring) Then
sum_data(1, j) = sum_data(1, j) + sqlstring
End If
If IsNull(sqlstring) Then
sqlstring = ret.Fields(ret.Fields.Item(j).Name)
Else
sqlstring = CStr(ret.Fields(ret.Fields.Item(j).Name))
End If
Cell1.DoDrawLine temp_jj + j, i + 1, temp_jj + j, i + 1, 4, 1, 0
Cell1.DoDrawLine temp_jj + j, i + 1, temp_jj + j, i + 1, 3, 1, 0
Cell1.DoSetCellData temp_jj + j, i + 1, sqlstring
Next j
i = i + 1
ret.MoveNext
Loop
For j = 0 To ret.Fields.Count - 1
If j = 0 Then
sqlstring = "合计"
Else
sqlstring = CStr(sum_data(1, j))
End If
Cell1.DoDrawLine temp_jj + j, i + 1, temp_jj + j, i + 1, 4, 1, 0
Cell1.DoDrawLine temp_jj + j, i + 1, temp_jj + j, i + 1, 3, 1, 0
Cell1.DoSetCellData temp_jj + j, i + 1, sqlstring
Next j
For j = 0 To ret.Fields.Count - 1
Cell1.DoDrawLine temp_jj + j, i + 1, temp_jj + j, i + 1, 5, 1, 0
Next j
ret.Close
i = i + 1
Else
Do While Not ret.EOF And i < Cell1.Rows
Cell1.DoDrawLine temp_jj, i, temp_jj, i, 2, 1, 0
For j = 0 To ret.Fields.Count - 1
sqlstring = ret.Fields(ret.Fields.Item(j).Name)
If IsNumeric(sqlstring) Then
sum_data(1, j) = sum_data(1, j) + sqlstring
End If
If IsNull(sqlstring) Then
sqlstring = ret.Fields(ret.Fields.Item(j).Name)
Else
sqlstring = CStr(ret.Fields(ret.Fields.Item(j).Name))
End If
Cell1.DoDrawLine temp_jj + j, i, temp_jj + j, i, 4, 1, 0
Cell1.DoDrawLine temp_jj + j, i, temp_jj + j, i, 3, 1, 0
Cell1.DoSetCellData temp_jj + j, i, sqlstring
Next j
i = i + 1
ret.MoveNext
Loop
For j = 0 To ret.Fields.Count - 1
If j = 0 Then
sqlstring = "合计"
Else
sqlstring = CStr(sum_data(1, j))
End If
Cell1.DoDrawLine temp_jj + j, i, temp_jj + j, i, 4, 1, 0
Cell1.DoDrawLine temp_jj + j, i, temp_jj + j, i, 3, 1, 0
Cell1.DoSetCellData temp_jj + j, i, sqlstring
Next j
For j = 0 To ret.Fields.Count - 1
Cell1.DoDrawLine temp_jj + j, i + 1, temp_jj + j, i + 1, 4, 1, 0
Next j
ret.Close
End If
i = i + 1
Do While i < Cell1.Rows '清除模版多余的表线
For j = 0 To Cell1.Cols - 1
Cell1.DoSetCellData temp_jj + j, i, Empty
Cell1.DoClearLine temp_jj + j, i, temp_jj + j, i, 2
Cell1.DoClearLine temp_jj + j, i, temp_jj + j, i, 3
Cell1.DoClearLine temp_jj + j, i + 1, temp_jj + j, i + 1, 4
Next j
i = i + 1
Loop
End If
Cell1.DoGetCellData temp_jj, temp_ii, funcResult
Case "sql_rowcol"
Dim ret_rowcol As New ADODB.Recordset
Dim temp_iii As Integer, temp_jjj As Integer
temp_iii = 0
For i = 0 To Cell1.Rows - 1 '取得公式所在的行?列号
For j = 0 To Cell1.Cols - 1
If Cell1.IsFormulaCell(j, i) = True Then
Cell1.DoGetFormula j, i, sqlstring
If InStr(1, sqlstring, la_paravar(0)) <> 0 Then
temp_iii = 1
Exit For
End If
End If
Next j
If temp_iii <> 0 Then
Exit For
End If
Next i
If temp_iii = 0 Then
i = Cell1.DoGetCurrentRow
temp_iii = i
temp_jjj = Cell1.DoGetCurrentCol
Else
temp_iii = i
temp_jjj = j
End If
If la_paravar(1) = "" Then '年月字段名为空
ls_SQLselect = la_paravar(0)
Else '年月字段名不为空
ls_year = mf_exchange_nyr(la_paravar(2)) '年月转换
ls_month = mf_exchange_nyr(la_paravar(3))
'年月日有效性校验
If mf_check_nyr(ls_year, ls_month) Then funcResult = CVErr(funcResult): Exit Sub
iInstr1 = InStr(1, la_paravar(1), ",")
iInstr2 = InStr(1, la_paravar(1), "$")
If iInstr2 > 0 Then '去除la_paravar(1)中的"$"
la_paravar(1) = Left(la_paravar(1), Len(la_paravar(1)) - 1)
End If
If iInstr2 > 0 Then '数据库中年月字段为字符型
If iInstr1 > 0 Then '数据库中年月字段为两个字段
ls_YearName = Left(la_paravar(1), iInstr1 - 1)
ls_MonthName = Right(la_paravar(1), Len(la_paravar(1)) - iInstr1)
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & ls_YearName & " ='" & ls_year & "' and " & ls_MonthName & " = '" & ls_month & "'"
Else
ls_SQLselect = la_paravar(0) & " where " & ls_YearName & " ='" & ls_year & "' and " & ls_MonthName & "= '" & ls_month & "'"
End If
Else
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & la_paravar(1) & " ='" & ls_year & "-" & ls_month & "'"
Else
ls_SQLselect = la_paravar(0) & " where " & la_paravar(1) & " ='" & ls_year & "-" & ls_month & "'"
End If
End If
Else '数据库中年月字段为数字型
If iInstr1 > 0 Then '数据库中年月字段为两个字段
ls_YearName = Left(la_paravar(1), iInstr1 - 1)
ls_MonthName = Right(la_paravar(1), Len(la_paravar(1)) - iInstr1)
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & ls_YearName & " =" & CInt(ls_year) & " and " & ls_MonthName & " = " & CInt(ls_month) & ""
Else
ls_SQLselect = la_paravar(0) & " where " & ls_YearName & " =" & CInt(ls_year) & " and " & ls_MonthName & "= " & CInt(ls_month) & ""
End If
Else
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & la_paravar(1) & " =" & CInt(ls_year) & "" & CInt(ls_month) & ""
Else
ls_SQLselect = la_paravar(0) & " where " & la_paravar(1) & " =" & CInt(ls_year) & "" & ls_month & ""
End If
End If
End If
End If
ret_rowcol.Open ls_SQLselect, Cw_DataEnvi.dataconnect, adOpenKeyset, adLockPessimistic, 8
If ret_rowcol.RecordCount = 0 Then
End If
If ret_rowcol.RecordCount > 0 Then
If Cell1.Cols - j < ret_rowcol.Fields.Count Then
Cell1.DoAppendCol ret_rowcol.Fields.Count + j - Cell1.Cols
End If
If Cell1.Rows - i < ret_rowcol.RecordCount + 1 Then
Cell1.DoAppendRow ret_rowcol.RecordCount + i - Cell1.Rows + 1
End If
Do While Not ret_rowcol.EOF And i < Cell1.Rows
For j = 0 To ret_rowcol.Fields.Count - 1
sqlstring = ret_rowcol.Fields(ret_rowcol.Fields.Item(j).Name)
Cell1.DoSetCellData temp_jjj + j, i, sqlstring
Next j
i = i + 1
ret_rowcol.MoveNext
Loop
ret_rowcol.Close
i = i + 1
End If
Cell1.DoGetCellData temp_jjj, temp_iii, funcResult
Case "sql_cell", "sql_col", "sql_row"
If la_paravar(1) = "" Then '年月字段名为空
ls_SQLselect = la_paravar(0)
Else '年月字段名不为空
ls_year = mf_exchange_nyr(la_paravar(2))
ls_month = mf_exchange_nyr(la_paravar(3))
If mf_check_nyr(ls_year, ls_month) Then funcResult = CVErr(funcResult): Exit Sub
iInstr1 = InStr(1, la_paravar(1), ",")
iInstr2 = InStr(1, la_paravar(1), "$")
If iInstr2 > 0 Then
la_paravar(1) = Left(la_paravar(1), Len(la_paravar(1)) - 1)
End If
If iInstr2 > 0 Then
If iInstr1 > 0 Then
ls_YearName = Left(la_paravar(1), iInstr1 - 1)
ls_MonthName = Right(la_paravar(1), Len(la_paravar(1)) - iInstr1)
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & ls_YearName & " ='" & ls_year & "' and " & ls_MonthName & " = '" & ls_month & "'"
Else
ls_SQLselect = la_paravar(0) & " where " & ls_YearName & " ='" & ls_year & "' and " & ls_MonthName & "= '" & ls_month & "'"
End If
Else
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & la_paravar(1) & " ='" & ls_year & "-" & ls_month & "'"
Else
ls_SQLselect = la_paravar(0) & " where " & la_paravar(1) & " ='" & ls_year & "-" & ls_month & "'"
End If
End If
Else
If iInstr1 > 0 Then
ls_YearName = Left(la_paravar(1), iInstr1 - 1)
ls_MonthName = Right(la_paravar(1), Len(la_paravar(1)) - iInstr1)
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & ls_YearName & " =" & CInt(ls_year) & " and " & ls_MonthName & " = " & CInt(ls_month) & ""
Else
ls_SQLselect = la_paravar(0) & " where " & ls_YearName & " =" & CInt(ls_year) & " and " & ls_MonthName & "= " & CInt(ls_month) & ""
End If
Else
If InStr(1, la_paravar(0), "where") Then
ls_SQLselect = la_paravar(0) & " and " & la_paravar(1) & " =" & CInt(ls_year) & "" & CInt(ls_month) & ""
Else
ls_SQLselect = la_paravar(0) & " where " & la_paravar(1) & " =" & CInt(ls_year) & "" & ls_month & ""
End If
End If
End If
End If
Set lrst_all = New ADODB.Recordset
lrst_all.CursorLocation = adUseClient
lrst_all.CursorType = adOpenKeyset
lrst_all.LockType = adLockBatchOptimistic
lrst_all.Open ls_SQLselect, Cw_DataEnvi.dataconnect
If lrst_all.RecordCount > 0 Then
If LCase(Name) = "sql_cell" Then
lrst_all.MoveFirst
sqlstring = lrst_all.Fields(0).Value
funcResult = sqlstring
ElseIf LCase(Name) = "sql_col" Then
lrst_all.MoveFirst
funcResult = lrst_all.Fields(0).Value
lrst_all.MoveNext
ls_row = Cell1.DoGetCurrentRow + 1
ls_col = Cell1.DoGetCurrentCol
Do While Not lrst_all.EOF
sqlstring = lrst_all.Fields(0).Value
Cell1.DoSetCellData ls_col, ls_row, sqlstring
lrst_all.MoveNext
ls_row = ls_row + 1
Loop
Cell1.DoRedrawAll
ElseIf LCase(Name) = "sql_row" Then
lrst_all.MoveFirst
funcResult = lrst_all.Fields(0).Value
ls_row = Cell1.DoGetCurrentRow
ls_col = Cell1.DoGetCurrentCol + 1
lrst_all.MoveNext
Do While Not lrst_all.EOF
sqlstring = lrst_all.Fields(0).Value
Cell1.DoSetCellData ls_col, ls_row, sqlstring
lrst_all.MoveNext
ls_col = ls_col + 1
Loop
Cell1.DoRedrawAll
End If
Else
funcResult = 0
End If
lrst_all.Close
Set lrst_all = Nothing
Case "save_data"
ls_select = "要增加" & la_paravar(0) & "数据表记录吗?"
If MsgBox(ls_select, vbYesNo + vbQuestion, "提示信息") = vbNo Then
Exit Sub
Else
'读取第一个单元格的列?行
iInstr1 = InStr(1, la_paravar(1), "$")
tStr = Mid(la_paravar(1), 1, iInstr1 - 1) '截取第一个单元
ls_col = Asc(UCase(Mid(tStr, 1, 1))) - 65 '将字母转换成数字
ls_row = Mid(tStr, 2, Len(tStr) - 1) - 1
Cell1.DoGetCellData ls_col, ls_row, sqlstring
ls_select = "select * from " & la_paravar(0) & ""
Set lrst_all = New ADODB.Recordset
lrst_all.CursorLocation = adUseClient
lrst_all.CursorType = adOpenDynamic
lrst_all.LockType = adLockOptimistic
lrst_all.Open ls_select, Cw_DataEnvi.dataconnect
iInstr2 = lrst_all.Fields(0).Name '读取数据表的第一个字段名称
lrst_all.Close
'查找与第一个单元格内容相等的记录
ls_select = "select * from " & la_paravar(0) & " where " & iInstr2 & " = '" & sqlstring & "'"
lrst_all.Open ls_select, Cw_DataEnvi.dataconnect
If lrst_all.EOF Then '无相等的记录
lrst_all.AddNew
lrst_all.Fields(0).Value = sqlstring
Else '有相等的记录
lrst_all.Fields(0).Value = sqlstring
End If
i = 1
iInstr2 = la_paravar(1)
Do While iInstr1 <> 0 '用循环从字符串中截取第一个单元以后的单元
iInstr2 = Mid(iInstr2, iInstr1 + 1, Len(iInstr2))
iInstr1 = InStr(1, iInstr2, "$")
If iInstr1 <> 0 Then
tStr = Mid(iInstr2, 1, iInstr1 - 1)
Else
tStr = iInstr2
End If
ls_col = Asc(UCase(Mid(tStr, 1, 1))) - 65
ls_row = Mid(tStr, 2, Len(tStr) - 1) - 1
Cell1.DoGetCellData ls_col, ls_row, sqlstring
lrst_all.Fields(i).Value = sqlstring
i = i + 1
Loop
lrst_all.Update
lrst_all.Close
Set lrst_all = Nothing
End If
End Select
Exit Sub
err_msg:
MsgBox "公式输入错误,请仔细检查!", vbOKOnly + vbExclamation, "提示信息——百利/ERP5.0-电子报表"
funcResult = CVErr(funcResult)
End Sub
Private Function PowerSupply(str_MonYear As String, str_unitName As String) As Single
On Error GoTo errExecute
Dim int_Temp As Integer
Dim str_Sqltemp As String
Dim str_Temp As String
Dim rst_temp As New ADODB.Recordset
Dim str_ItemCode As String
Dim str_UnitCode As String
Dim Bln_LeftPage As Boolean
Dim str_UnitCodeForSum As String
Dim Sng_SumTemp As Single
Dim int_OtherTemp As Integer
Dim Str_OtherSqltemp As String
Dim rst_Othertemp As New ADODB.Recordset
Dim rst_FactCode As New ADODB.Recordset
Dim i As Integer
'''''''''''''''''
Dim str_NowFactCode As String
Dim Sng_SumTotal As Single '总公司电量
Dim Sng_SumFenQi As Single '期的总电量
Dim Sng_SumOtherUnit As Single '其它单元的总电量
Dim Sng_FenQiUnit As Single '当前期电量
Dim Sng_SumTotalSunHao As Single '总损耗
Dim Sng_SumOtherUnitSunHao As Single '其它单位总损耗
Dim Sng_FenQISunHao As Single '当前期的损耗
Dim Sng_SumDongLi As Single '当前动力总电量
Dim Sng_SumDongLiSunhao As Single '动力损耗
'''''''''''''''''
Dim Mon As String
Dim Year As String
Dim YearMon As String
Year = Mid(Trim(str_MonYear), 1, 4)
Mon = Mid(Trim(str_MonYear), 5, 2)
Mon = Trim(Str(Val(Mon) - 1))
If Len(Mon) <> 2 Then
Mon = "0" & Mon
End If
If Val(Mon) = 0 Then
Year = Str(Val(Year) - 1)
Mon = "12"
End If
YearMon = Year & Mon
''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''进入总电量操作
str_Sqltemp = "SELECT AA.ItemMuti * (ISNULL(AA.Reading, 0) - ISNULL" & _
" (((SELECT DL_monthElectChild.Reading " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild ON " & _
" DL_monthElect.ID = DL_monthElectChild.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON DL_monthElectChild.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & YearMon & "') AND " & _
" (DL_unit.UnitName LIKE '%总公司%') AND " & _
" (DL_monthElectChild.ItemCode = AA.ItemCode))), 0)) AS REMONSTRATE, " & _
" DL_item.ItemCode , DL_unit.UnitName " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild AA ON DL_monthElect.ID = AA.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON AA.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & str_MonYear & "') AND (DL_unit.UnitName LIKE '%总公司%') "
Set rst_temp = Cw_DataEnvi.dataconnect.Execute(str_Sqltemp)
Sng_SumTotal = 0
If rst_temp.RecordCount <> 0 Then
For int_Temp = 1 To rst_temp.RecordCount
Sng_SumTotal = Sng_SumTotal + rst_temp.Fields(0).Value
rst_temp.MoveNext
Next int_Temp
End If
rst_temp.Close
''''''''''''''''''' 求期的总和电量
str_Sqltemp = "SELECT AA.ItemMuti * (ISNULL(AA.Reading, 0) - ISNULL" & _
" (((SELECT DL_monthElectChild.Reading " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild ON " & _
" DL_monthElect.ID = DL_monthElectChild.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON DL_monthElectChild.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & YearMon & "') AND " & _
" (DL_unit.UnitName LIKE '%期%') AND " & _
" (DL_monthElectChild.ItemCode = AA.ItemCode))), 0)) AS REMONSTRATE, " & _
" DL_item.ItemCode , DL_unit.UnitName " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild AA ON DL_monthElect.ID = AA.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON AA.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & str_MonYear & "') AND (DL_unit.UnitName LIKE '%期%') "
Set rst_temp = Cw_DataEnvi.dataconnect.Execute(str_Sqltemp)
Sng_SumFenQi = 0
If rst_temp.RecordCount <> 0 Then
For int_Temp = 1 To rst_temp.RecordCount
Sng_SumFenQi = Sng_SumFenQi + rst_temp.Fields(0).Value
rst_temp.MoveNext
Next int_Temp
End If
rst_temp.Close
'''''''''''''''''''''''''''''''''''''''''''''
If InStr(1, str_unitName, "生活") <> 0 Or InStr(1, str_unitName, "产前区") <> 0 Then
str_unitName = "生活"
ElseIf InStr(1, str_unitName, "其他") <> 0 Or InStr(1, str_unitName, "其它") <> 0 Then
str_unitName = "外来单位"
ElseIf InStr(1, str_unitName, "仓库") <> 0 Then
str_unitName = "营销部"
End If
PowerSupply = 0
str_Temp = " SELECT DISTINCT" & _
" DL_factory.FactName, DL_factory.FactCode, DL_unit.UnitName, " & _
" DL_unit.UnitCode " & _
" FROM DL_item INNER JOIN " & _
" DL_factory ON DL_item.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_item.UnitCode = DL_unit.UnitCode " & _
" WHERE DL_unit.UnitName like '%" & str_unitName & "%'"
Set rst_FactCode = Cw_DataEnvi.dataconnect.Execute(str_Temp)
If rst_FactCode.RecordCount = 0 Then
PowerSupply = 0
Exit Function
End If
rst_FactCode.MoveFirst
For i = 1 To rst_FactCode.RecordCount
str_NowFactCode = Trim(rst_FactCode.Fields("FactCode"))
''''''''''''''''''''''求得当前分厂其它单位电量和
str_Sqltemp = "SELECT AA.ItemMuti * (ISNULL(AA.Reading, 0) - ISNULL" & _
" (((SELECT DL_monthElectChild.Reading " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild ON " & _
" DL_monthElect.ID = DL_monthElectChild.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON DL_monthElectChild.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & YearMon & "') AND " & _
" (DL_unit.UnitName NOT LIKE '%期%') AND " & _
" (DL_unit.UnitName NOT LIKE '%总公司%') AND " & _
" (DL_monthElect.FactCode = '" & str_NowFactCode & "') AND " & _
" (DL_monthElectChild.ItemCode = AA.ItemCode))), 0)) AS REMONSTRATE, " & _
" DL_item.ItemCode , DL_unit.UnitName " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild AA ON DL_monthElect.ID = AA.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON AA.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & str_MonYear & "') AND (DL_unit.UnitName NOT LIKE '%期%') " & _
" AND (DL_unit.UnitName NOT LIKE '%总公司%') AND (DL_monthElect.FactCode = '" & str_NowFactCode & "') "
Set rst_temp = Cw_DataEnvi.dataconnect.Execute(str_Sqltemp)
Sng_SumOtherUnit = 0
If rst_temp.RecordCount <> 0 Then
For int_Temp = 1 To rst_temp.RecordCount
Sng_SumOtherUnit = Sng_SumOtherUnit + rst_temp.Fields(0).Value
rst_temp.MoveNext
Next int_Temp
End If
rst_temp.Close
''''''''''''''''''''''求得当前期的电量
str_Sqltemp = "SELECT AA.ItemMuti * (ISNULL(AA.Reading, 0) - ISNULL" & _
" (((SELECT DL_monthElectChild.Reading " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild ON " & _
" DL_monthElect.ID = DL_monthElectChild.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON DL_monthElectChild.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & YearMon & "') AND " & _
" (DL_unit.UnitName LIKE '%期%') AND " & _
" (DL_monthElect.FactCode = '" & str_NowFactCode & "') AND " & _
" (DL_monthElectChild.ItemCode = AA.ItemCode))), 0)) AS REMONSTRATE, " & _
" DL_item.ItemCode , DL_unit.UnitName " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild AA ON DL_monthElect.ID = AA.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON AA.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & str_MonYear & "') AND (DL_unit.UnitName LIKE '%期%') " & _
" AND (DL_monthElect.FactCode = '" & str_NowFactCode & "') "
Set rst_temp = Cw_DataEnvi.dataconnect.Execute(str_Sqltemp)
Sng_FenQiUnit = 0
If rst_temp.RecordCount <> 0 Then
For int_Temp = 1 To rst_temp.RecordCount
Sng_FenQiUnit = Sng_FenQiUnit + rst_temp.Fields(0).Value
rst_temp.MoveNext
Next int_Temp
End If
rst_temp.Close
'''''''''''''''''''''' 求得总损耗
Sng_SumTotalSunHao = Sng_SumTotal - Sng_SumFenQi
''''''''''''''''''''''求得当前期损耗
Sng_FenQISunHao = 0
If Sng_SumFenQi <> 0 Then
Sng_FenQISunHao = Sng_SumTotalSunHao * Sng_FenQiUnit / Sng_SumFenQi
End If
'''''''''''''''''''''求得其它单位总损耗
Sng_SumOtherUnitSunHao = Sng_FenQiUnit - Sng_SumOtherUnit + Sng_FenQISunHao
'''''''''''''''''''''求得动力总和
str_Sqltemp = "SELECT AA.ItemMuti * (ISNULL(AA.Reading, 0) - ISNULL" & _
" (((SELECT DL_monthElectChild.Reading " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild ON " & _
" DL_monthElect.ID = DL_monthElectChild.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON DL_monthElectChild.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & YearMon & "') AND " & _
" (DL_unit.UnitName LIKE '%" & Trim(str_unitName) & "%') " & _
" AND (DL_monthElect.FactCode = '" & str_NowFactCode & "') AND " & _
" (DL_monthElectChild.ItemCode = AA.ItemCode))), 0)) AS REMONSTRATE, " & _
" DL_item.ItemCode , DL_unit.UnitName " & _
" FROM DL_monthElect INNER JOIN " & _
" DL_monthElectChild AA ON DL_monthElect.ID = AA.ID INNER JOIN " & _
" DL_factory ON DL_monthElect.FactCode = DL_factory.FactCode INNER JOIN " & _
" DL_unit ON DL_monthElect.UnitCode = DL_unit.UnitCode INNER JOIN " & _
" DL_item ON AA.ItemCode = DL_item.ItemCode AND " & _
" DL_factory.FactCode = DL_item.FactCode AND " & _
" DL_unit.UnitCode = DL_item.UnitCode " & _
" WHERE (DL_monthElect.Yearmon = '" & str_MonYear & "') AND (DL_unit.UnitName LIKE '%" & Trim(str_unitName) & "%') " & _
" AND (DL_monthElect.FactCode = '" & str_NowFactCode & "') "
Set rst_temp = Cw_DataEnvi.dataconnect.Execute(str_Sqltemp)
Sng_SumDongLi = 0
If rst_temp.RecordCount <> 0 Then
For int_Temp = 1 To rst_temp.RecordCount
Sng_SumDongLi = Sng_SumDongLi + rst_temp.Fields(0).Value
rst_temp.MoveNext
Next int_Temp
End If
'''''''''''''''''''求得总损耗
Sng_SumDongLiSunhao = 0
If Sng_SumOtherUnit <> 0 Then
Sng_SumDongLiSunhao = Sng_SumOtherUnitSunHao * Sng_SumDongLi / Sng_SumOtherUnit
End If
'''''''''''''''''''''''结束
PowerSupply = PowerSupply + Sng_SumDongLiSunhao + Sng_SumDongLi
'''''''''''''''''''''''
rst_FactCode.MoveNext
Next i
Exit Function
errExecute:
If Err.Number = -2147467259 Then
MsgBox "数据库连接失败,请检查网络!", vbApplicationModal + vbCritical + vbSystemModal, "错误"
Err.Number = 0
Unload Me
Exit Function
Else
MsgBox "操作出现异常,请重新操作!", vbApplicationModal + vbCritical + vbSystemModal, "错误"
Err.Number = 0
' Unload Me
End If
End Function
Private Sub Cell1_OnUserFuncGuide2(ByVal parent As Long, ByVal funcname As String, guidestring As String)
song_temp = funcname
Select Case Mid(UCase(song_temp), 1, 2)
Case "SQ"
If UCase(song_temp) = "SQL_ALL" Then
guidestring = song_temp & "(" + Chr(34) + "SQL语句" + Chr(34) + _
"," + Chr(34) + "年月字段名" + Chr(34) + _
"," + Chr(34) + "年" + Chr(34) + _
"," + Chr(34) + "月" + Chr(34) + _
"," + Chr(34) + "标志" + Chr(34) & ")"
Else
guidestring = song_temp & "(" + Chr(34) + "SQL语句" + Chr(34) + _
"," + Chr(34) + "年月字段名" + Chr(34) + _
"," + Chr(34) + "年" + Chr(34) + _
"," + Chr(34) + "月" + Chr(34) & ")"
End If
Case "DA"
guidestring = song_temp & "(" + Chr(34) + Chr(34) & ")"
Case "JE", "SL", "WB", "XM"
frm_formula.Show vbModal, MDI_frame
guidestring = song_temp
End Select
End Sub
Private Sub Form_Load()
If mf_cell_login() = False Then
MsgBox "cell控件注册失败!", vbOKOnly + vbExclamation, "百利/ERP5.0-电子报表"
Exit Sub
End If
mf_addfunction
Select Case ml_edit_lx
Case 1
Set mcls_open_report = New cls_open_report
mcls_open_report.ls_report_model_id = MDI_frame.mcls_open_report.ls_report_model_id
mcls_open_report.ls_report_model_name = MDI_frame.mcls_open_report.ls_report_model_name
mcls_open_report.ls_system_code = MDI_frame.mcls_open_report.ls_system_code
mcls_open_report.ldate_report_time = MDI_frame.mcls_open_report.ldate_report_time
Caption = "编辑报表系统编码:" & mcls_open_report.ls_system_code & _
" 报表模板号:" & mcls_open_report.ls_report_model_id & _
" 报表模板名称:" & mcls_open_report.ls_report_model_name & _
" 制作时间:" & CStr(mcls_open_report.ldate_report_time)
Set MDI_frame.mcls_open_report = Nothing
mdi_frame.m_recompute.enabled=false
Case 2
Set mcls_open_report_model = New cls_open_report_model
mcls_open_report_model.ls_report_model_id = MDI_frame.mcls_open_report_model.ls_report_model_id
mcls_open_report_model.ls_report_model_name = MDI_frame.mcls_open_report_model.ls_report_model_name
mcls_open_report_model.ls_system_code = MDI_frame.mcls_open_report_model.ls_system_code
Caption = "编辑报表模板系统编码:" & mcls_open_report_model.ls_system_code & _
" 报表模板号:" & mcls_open_report_model.ls_report_model_id & _
" 报表模板名称:" & mcls_open_report_model.ls_report_model_name
Set MDI_frame.mcls_open_report_model = Nothing
Case 3
mdi_frame.m_recompute.enabled=false
Case 4
Set mcls_new_report = New cls_new_report
mcls_new_report.ls_report_model_id = MDI_frame.mcls_new_report.ls_report_model_id
mcls_new_report.ls_report_model_name = MDI_frame.mcls_new_report.ls_report_model_name
mcls_new_report.ls_system_code = MDI_frame.mcls_new_report.ls_system_code
Caption = "新建报表系统编码:" & mcls_new_report.ls_system_code & _
" 报表模板号:" & mcls_new_report.ls_report_model_id & _
" 报表模板名称:" & mcls_new_report.ls_report_model_name
Set MDI_frame.mcls_new_report = Nothing
mdi_frame.m_recompute.enabled=true
Case 5
Set mcls_new_report_model = New cls_new_report_model
mcls_new_report_model.ls_system_code = MDI_frame.mcls_new_report_model.ls_system_code
mcls_new_report_model.ls_report_model_id = MDI_frame.mcls_new_report_model.ls_report_model_id
mcls_new_report_model.ls_report_model_name = MDI_frame.mcls_new_report_model.ls_report_model_name
Caption = "新建报表模板系统编码:" & mcls_new_report_model.ls_system_code & _
" 报表模板号:" & mcls_new_report_model.ls_report_model_id & _
" 报表模板名称:" & mcls_new_report_model.ls_report_model_name
Cell1.Rows = 25
Cell1.Cols = 10
Set MDI_frame.mcls_new_report_model = Nothing
Case 6
Caption = "编辑表格: 表格" & CStr(MDI_frame.ml_new_file_count)
Cell1.Rows = 25
Cell1.Cols = 10
mdi_frame.m_recompute.enabled=true
Case 7
Caption = "编辑表格: 表格:汇总表" & CStr(MDI_frame.ml_frmedit_count) & "汇总表"
Set mcls_new_report_model = New cls_new_report_model
mdi_frame.m_recompute.enabled=true
End Select
mf_open ml_edit_lx
If MDI_frame.ml_frmedit_count = 1 Then
mf_setmenu 1
mf_settoolbar 1
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim ll_msg As Integer
If Cell1.IsModified = False Then
Exit Sub
End If
Select Case ml_edit_lx
Case 1
ll_msg = MsgBox("报表" & vbCrLf _
& " 系统编码:" & Me.mcls_open_report.ls_system_code & vbCrLf _
& " 模板名称:" & Me.mcls_open_report.ls_report_model_name & vbCrLf _
& " 制作时间:" & CStr(Me.mcls_open_report.ldate_report_time) _
& vbCrLf & "已经改变,是否保存?", vbYesNoCancel + vbQuestion + vbDefaultButton3, "百利/ERP5.0-电子报表")
Case 2
ll_msg = MsgBox("报表模板" & vbCrLf _
& " 系统编码:" & Me.mcls_open_report_model.ls_system_code & vbCrLf _
& " 模板名称:" & Me.mcls_open_report_model.ls_report_model_name _
& vbCrLf & "已经改变,是否保存?", vbYesNoCancel + vbQuestion + vbDefaultButton3, "百利/ERP5.0-电子报表")
Case 3
ll_msg = MsgBox("文件 “" & Me.ms_filename & "” 已经改变,是否保存?", vbYesNoCancel + vbQuestion + vbDefaultButton3, "百利/ERP5.0-电子报表")
Case 4
ll_msg = MsgBox("新建报表" & vbCrLf _
& " 系统编码:" & Me.mcls_new_report.ls_system_code & vbCrLf _
& " 模板名称:" & Me.mcls_new_report.ls_report_model_name _
& vbCrLf & "已经改变,是否保存?", vbYesNoCancel + vbQuestion + vbDefaultButton3, "百利/ERP5.0-电子报表")
Case 5
ll_msg = MsgBox("新建报表模板" & vbCrLf _
& " 系统编码:" & Me.mcls_new_report_model.ls_system_code _
& " 模板名称:" & Me.mcls_new_report_model.ls_report_model_name _
& vbCrLf & "已经改变,是否保存?", vbYesNoCancel + vbQuestion + vbDefaultButton3, "百利/ERP5.0-电子报表")
Case 6
ll_msg = MsgBox("文件 “" & Right(Me.Caption, Len(Me.Caption) - 9) & "” 已经改变,是否保存?", vbYesNoCancel + vbQuestion + vbDefaultButton3, "百利/ERP5.0-电子报表")
End Select
Select Case ll_msg
Case vbYes
mf_save ml_edit_lx
Case vbNo
Case vbCancel
Cell1.DoSetModifiedFlag True
Cancel = 1
End Select
End Sub
Private Sub Form_Resize()
Cell1.Left = 0
Cell1.Width = Me.ScaleWidth
Cell1.Top = 0
Cell1.Height = Me.ScaleHeight
End Sub
Private Sub Form_Unload(Cancel As Integer)
With MDI_frame
.ml_frmedit_count = .ml_frmedit_count - 1
If .ml_frmedit_count = 0 Then
mf_setmenu 0
mf_settoolbar 0
End If
End With
'修改标题
song_flag = False
MDI_frame.StatusBar1.Panels(2).Text = "操作状态:正在等待用户选择操作"
MDI_frame.Caption = Left(MDI_frame.Caption, 15)
End Sub
'日期合法性校验
Public Function mf_check_nyr(lsYear As String, lsMonth As String) As Boolean
Dim li_month As Integer
mf_check_nyr = False
If lsYear = "-100" Then
MsgBox "年份必须位整数值!", vbOKOnly, "百利/ERP5.0-电子报表"
mf_check_nyr = True
Exit Function
End If
If lsMonth = "-100" Then
MsgBox "月份必须位整数值!", vbOKOnly, "百利/ERP5.0-电子报表"
mf_check_nyr = True
Exit Function
End If
li_month = CInt(lsMonth)
If li_month > 12 Or li_month < 0 Then
MsgBox "月份超出范围!", vbOKOnly, "百利/ERP5.0-电子报表"
mf_check_nyr = True
Exit Function
End If
End Function
Public Function cell_zhdx1(Jesj) As String '大写金额转换
'//* 功能: 金额小写转换为大写调用参数:jesj...人民币小写金额
'//* 返回变量: name..人民币大写金额
Dim Name1$, Name2$, Mje1$, Name$, wz1$, wz2$, wz3$
Dim len_mje1%, k%, Ws%, j%, ws1%, m%
Dim Bz As Boolean
Name1 = "壹贰叁肆伍陆柒捌玖"
Name2 = "分角元拾佰仟万拾佰仟亿拾佰仟"
Mje1 = Trim(Format(Jesj, "###.00"))
len_mje1 = Len(Mje1)
If len_mje1 > 16 Or Jesj < 0.01 Or IsNull(Jesj) Then
cell_zhdx1 = ""
Exit Function
End If
'//取无小数的字符串
Mje1 = Left(Mje1, len_mje1 - 3) + Right(Mje1, 2)
len_mje1 = len_mje1 - 1
k = len_mje1 * 2 - 1
Ws = Int(Mid(Mje1, 1, 1)) * 2 - 1
If len_mje1 = 3 And Ws < 0 Then '//如果金额<1 name=''
Name = ""
Else
If Ws > 0 Then
Name = MidB(Name1, Ws, 2) + MidB(Name2, k, 2) '//如果金额>=1,转换金额
End If
End If
j = 2
k = k - 2
Bz = True
xh1:
Do While j <= len_mje1 And Bz
ws1 = Int(Mid(Mje1, j, 1)) * 2 - 1
If ws1 > 0 Then
Name = Name + MidB(Name1, ws1, 2) + MidB(Name2, k, 2)
j = j + 1
k = k - 2
GoTo xh1
End If
m = 0
xh2:
Do While ws1 < 0
If len_mje1 >= 11 Then
If k < 21 Then
m = m + 1
End If
End If
If k = 5 Or (k = 13 And m <= 3) Or k = 21 Then
Name = Name + MidB(Name2, k, 2)
End If
If k = 1 Then
Name = Name + "整"
Bz = False
Exit Do
End If
j = j + 1
k = k - 2
ws1 = Int(Mid(Mje1, j, 1)) * 2 - 1
If ws1 < 0 Then
GoTo xh2
Else
If len_mje1 = 3 Then
Name = Name + "零"
Else
Name = Name + "零"
End If
End If
Loop
Loop
'去掉元和角之间零(1230.32)
wz1 = InStr(1, Name, "元")
wz2 = InStr(1, Name, "角")
If wz1 <> 0 And wz2 <> 0 Then
wz3 = InStr(wz1, Name, "零")
If wz3 <> 0 Then
Name = Mid(Name, 1, wz3 - 1) + Mid(Name, wz3 + 1, Len(Name))
End If
End If
cell_zhdx1 = Name
End Function
Public Function cell_zhdx2(Jesj) As String '金额转换中文大写
'//* 功能: 金额小写转换为大写调用参数:jesj...人民币小写金额
'//* 返回变量: name..中文大写
Dim Name1$, Name2$, Mje1$, Name$, wz1$, wz2$, wz3$
Dim len_mje1%, k%, Ws%, j%, ws1%, m%
Dim Bz As Boolean
Dim iArray(10) As String
iArray(0) = "零"
iArray(1) = "壹"
iArray(2) = "贰"
iArray(3) = "叁"
iArray(4) = "肆"
iArray(5) = "伍"
iArray(6) = "陆"
iArray(7) = "柒"
iArray(8) = "捌"
iArray(9) = "玖"
Name = ""
For i = 1 To Len(Trim(Str(Jesj)))
wz1 = Mid(Trim(Str(Jesj)), i, 1)
Name = Name + iArray(Val(wz1))
Next i
If Len(Trim(Str(Jesj))) = 1 Then
Name = "零" + Name
End If
If Len(Trim(Str(Jesj))) = 2 Then
Name1 = Mid(Name, 1, 1)
Name2 = Mid(Name, 2, 1)
Name = Name1 + "拾" + Name2
End If
cell_zhdx2 = Name
End Function
Public Function cell_zhdx3(Jesj) As String '金额转换中文大写
'//* 功能: 金额小写转换为大写调用参数:jesj...人民币小写金额
'//* 返回变量: name..中文大写
Dim Name1$, Name2$, Mje1$, Name$, wz1$, wz2$, wz3$
Dim len_mje1%, k%, Ws%, j%, ws1%, m%
Dim Bz As Boolean
Dim iArray(10) As String
iArray(0) = "零"
iArray(1) = "一"
iArray(2) = "二"
iArray(3) = "三"
iArray(4) = "四"
iArray(5) = "五"
iArray(6) = "六"
iArray(7) = "七"
iArray(8) = "八"
iArray(9) = "九"
Name = ""
For i = 1 To Len(Trim(Str(Jesj)))
wz1 = Mid(Trim(Str(Jesj)), i, 1)
Name = Name + iArray(Val(wz1))
Next i
cell_zhdx3 = Name
End Function