VBA自定义用友报表函数

原创VBA自定义用友报表函数2008-09-17 13:15分类：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 FunctionIf 年度 = Year(Date) And 月份 = Month(Date) Then Exit FunctionDim 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