|
'取科目的期末值,支持未記賬取數和輔助核算，熟悉VBA設計和用友數據庫結構的網友可據此開發(fā)出更多實用的報表函數。我將其命名為UfoInExcel程序，意思是在Excel中可以像UFO一樣取數，而實用性更勝于UFO，因為Excel的優(yōu)越性地球人都知道。 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 ''+發(fā)生 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 |
|
|
