VBA自定义用友报表函数

'取科目的期末值,支持未记账取数和辅助核算，熟悉VBA设计和用友数据库结构的网友可据此开发出更多实用的报表函数。我将其命名为UfoInExcel程序，意思是在Excel中可以像UFO一样取数，而实用性更胜于UFO，因为Excel的优越性地球人都知道。
Function qm(科目代码, 月份, Optional 年度 As String, Optional 帐套号 As String, Optional 包含未记帐 As String = "Y", Optional 辅助核算方式 As String, Optional 辅助核算编码 As String)
If 年度 > Year(Date) Then Exit Function
If 年度 = Year(Date) And 月份 >= Month(Date) Then Exit Function
Dim csqlstr As String
    qm = 0
    If Trim(科目代码) = "" Then Exit Function
    If Trim(月份) = "" Then Exit Function
    If Trim(年度) = "" Then Exit Function
    If Trim(帐套号) = ""  Then Exit Function
    Set conn = New ADODB.Connection
    With conn
        .ConnectionString = "driver={SQL Server};server=U8SERVER;uid=sa;pwd=123456;database=UFDATA" & "_" & 帐套号 & "_" & Trim(年度)
        .Open  'strConn
    End With
    If Trim(辅助核算方式) <> "" And Trim(辅助核算编码) = "" Then
    qm = "缺少核算编码"
    conn.Close
        Set conn = Nothing
        Exit Function
    End If
   
If UCase(Trim(包含未记帐)) = "Y" Then ''如果包含未记账
   
    ''年初
    csqlstr = "SELECT sum((CASE WHEN cbegind_c<>'贷' THEN mb ELSE -mb End)) FROM "
    If Trim(辅助核算方式) = "" And Trim(辅助核算编码) = "" Then
    csqlstr = csqlstr & "gl_accsum "
    Else  ''如果要取辅助核算的数,要换一个数据库
    csqlstr = csqlstr & "gl_accass "
    End If
    csqlstr = csqlstr & " WHERE iperiod = 1 and ccode = " & SqlStr(科目代码)
    '注意辅助编码若以0开头，必须加上引号
    If Trim(辅助核算方式) = "" And Trim(辅助核算编码) = "" Then
    csqlstr = csqlstr
    ElseIf Trim(辅助核算方式) = "客户" Then
    csqlstr = csqlstr & "and ccus_id=" & "'" & Trim(辅助核算编码) & "'"
    ElseIf Trim(辅助核算方式) = "供应商" Then
    csqlstr = csqlstr & "and csup_id=" & "'" & Trim(辅助核算编码) & "'"
    ElseIf Trim(辅助核算方式) = "个人" Then
    csqlstr = csqlstr & "and cperson_id=" & "'" & Trim(辅助核算编码) & "'"
    ElseIf Trim(辅助核算方式) = "项目" Then
    csqlstr = csqlstr & "and citem_id=" & "'" & Trim(辅助核算编码) & "'"
    End If
   
    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = conn
        .Open csqlstr
    End With
   
    If IsNumeric(rst.Fields(0).Value) = True Then
    If Left(Trim(科目代码), 1) <> "2" And Left(Trim(科目代码), 1) <> "3" Then
        qm = rst.Fields(0).Value
    Else
        qm = -rst.Fields(0).Value
    End If
    End If
    Set rst = Nothing
   
    ''+发生
    csqlstr = "select sum(md-mc) FROM gl_accvouch where iperiod >= 1 and iperiod <=" & 月份 & " AND iflag is null AND ccode "
    If ifbend(conn, 科目代码) = 1 Then
    csqlstr = csqlstr & "=" & SqlStr(科目代码)
    Else
        csqlstr = csqlstr & "like " & SqlStr(科目代码 & "%")
    End If
       
    '注意辅助编码若以0开头，必须加上引号
    If Trim(辅助核算方式) = "" And Trim(辅助核算编码) = "" Then
    csqlstr = csqlstr
    ElseIf Trim(辅助核算方式) = "客户" Then
    csqlstr = csqlstr & "and ccus_id=" & "'" & Trim(辅助核算编码) & "'"
    ElseIf Trim(辅助核算方式) = "供应商" Then
    csqlstr = csqlstr & "and csup_id=" & "'" & Trim(辅助核算编码) & "'"
    ElseIf Trim(辅助核算方式) = "个人" Then
    csqlstr = csqlstr & "and cperson_id=" & "'" & Trim(辅助核算编码) & "'"
    ElseIf Trim(辅助核算方式) = "项目" Then
    csqlstr = csqlstr & "and citem_id=" & "'" & Trim(辅助核算编码) & "'"
    End If
   
    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = conn
        .Open csqlstr
    End With
    If IsNumeric(rst.Fields(0).Value) = True Then
    If Left(Trim(科目代码), 1) <> "2" And Left(Trim(科目代码), 1) <> "3" Then
        qm = qm + rst.Fields(0).Value
    Else
        qm = qm - rst.Fields(0).Value
    End If
    End If
    Set rst = Nothing
   
Else ''如果不包含未记账
   
    csqlstr = "SELECT SUM((CASE WHEN a.cendd_c <> '贷' THEN a.me ELSE - a.me END))" & _
              " AS SumVal " & _
              " FROM code b INNER JOIN " & _
              " gl_accass a ON b.ccode = a.ccode " & _
              " WHERE a.iperiod = " & 月份 & " AND a.ccode = " & SqlStr(科目代码)
   
    '注意辅助编码若以0开头，必须加上引号
    If Trim(辅助核算方式) = "" And Trim(辅助核算编码) = "" Then
    csqlstr = csqlstr
    ElseIf Trim(辅助核算方式) = "客户" Then
    csqlstr = csqlstr & "and ccus_id=" & "'" & Trim(辅助核算编码) & "'"
    ElseIf Trim(辅助核算方式) = "供应商" Then
    csqlstr = csqlstr & "and csup_id=" & "'" & Trim(辅助核算编码) & "'"
    ElseIf Trim(辅助核算方式) = "个人" Then
    csqlstr = csqlstr & "and cperson_id=" & "'" & Trim(辅助核算编码) & "'"
    ElseIf Trim(辅助核算方式) = "项目" Then
    csqlstr = csqlstr & "and citem_id=" & "'" & Trim(辅助核算编码) & "'"
    End If
   
    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = conn
        .Open csqlstr
    End With
    If IsNumeric(rst.Fields(0).Value) = True Then
    If Left(Trim(科目代码), 1) <> "2" And Left(Trim(科目代码), 1) <> "3" Then
        qm = rst.Fields(0).Value
    Else
        qm = -rst.Fields(0).Value
    End If
    End If
    Set rst = Nothing
End If
    conn.Close
    Set conn = Nothing
End Function