× Linguagem de Programação ADVPL

Perguntas Sub total em relatorio

Mais
9 anos 9 meses atrás #27107 por anizio.souza
Boa tarde pessoal.

Estou adaptando um fonte que baixei da internet para um cliente e preciso que imprima sub-totais por filial. Se puderem me ajudar, desde já agradeço. Abaixo segue fonte:

#INCLUDE "rwmake.ch"
#INCLUDE "TOPCONN.CH"
#INCLUDE "PROTHEUS.CH"


User Function TransfHT()

//ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
//³ Declaracao de Variaveis ³
//ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

Local cDesc1 := "Este programa tem como objetivo imprimir relatorio "
Local cDesc2 := "de acordo com os parametros informados pelo usuario."
Local cDesc3 := ""
Local cPict := ""
Local titulo := "Demonstrativo de Transferencia Entre Filiais"
Local Cabec1 := ""
Local Cabec2 := ""
Local imprime := .T.
Local aOrd := {}
Local cPerg := PadR("TRFHT",Len(SX1->X1_GRUPO))
Local nLin := 80
Private lEnd := .F.
Private lAbortPrint := .F.
Private CbTxt := ""
Private limite := 135
Private tamanho := "M"
Private nomeprog := "TransfHT" // Coloque aqui o nome do programa para impressao no cabecalho
Private nTipo := 18
Private aReturn := { "Zebrado", 1, "Administracao", 2, 2, 1, "", 1}
Private nLastKey := 0
Private cbtxt := Space(10)
Private cbcont := 00
Private CONTFL := 01
Private m_pag := 01
Private wnrel := "TransfHT" // Coloque aqui o nome do arquivo usado para impressao em disco
Private _aCabec := {}
Private cString := "SD2"
Private aCol := {02,10,16,28,32,47,61,74,79,83,88,94,110,120,132,140,149}

_aCabec := {{"Fil_Sai",7},{"Fil_Ent",7},{"Emissão",10},{"Serie",5},{"Nota",9},{"Produto",15},{"Total",14},{"TS",4},{"CFOP",5},{"TE",4},{"CFOP",5},{"Digitação",10},{"Alq_S",10},{"Alq_E",10},{"Icms_S",11},{"Icms_E",8},{"Dif_Icm",8}}


aEval(_aCabec,{|aPrm| Cabec1 += Padc(aPrm[01],aPrm[02]) + "|" })


criaSx1(cPerg)
If !Pergunte(cPerg, .T.)
Return
Endif

//ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
//³ Monta a interface padrao com o usuario... ³
//ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

wnrel := SetPrint("SD2",NomeProg,cPerg,@titulo,cDesc1,cDesc2,cDesc3,.T.,aOrd,.F.,Tamanho,,.T.)

If nLastKey == 27
Return Nil
Endif

SetDefault(aReturn,"SD2")

If nLastKey == 27
Return Nil
Endif

nTipo := If(aReturn[4]==1,15,18)

//ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
//³ Processamento. RPTSTATUS monta janela com a regua de processamento. ³
//ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

RptStatus({|| RunReport(Cabec1,Cabec2,Titulo,nLin) },Titulo)
Return

/*/
ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
±±ÉÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍ»±±
±±ºFun‡„o ³RUNREPORT º Autor ³ AP6 IDE º Data ³ 06/02/2015 º±±
±±ÌÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍ͹±±
±±ºDescri‡„o ³ Funcao auxiliar chamada pela RPTSTATUS. A funcao RPTSTATUS º±±
±±º ³ monta a janela com a regua de processamento. º±±
±±ÌÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹±±
±±ºUso ³ Programa principal º±±
±±ÈÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ±±
±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
/*/

Static Function RunReport(Cabec1,Cabec2,Titulo,nLin)

Local nOrdem
Local aLinha := {}
Local nX := 1
Local cProd := ""
Local nSumTot := 0 // SOMA DO TOTAL COLUNA TOTAL
Local nSumIcS := 0 // SOMA DO TOTAL COLUNA ICMS_S
Local nSumIcE := 0 // SOMA DO TOTAL COLUNA ICMS_E
Local nSumT := 0 // TOTAL DA DIF DO ICMS
Local cDescr := ""
Local lFlag := .T.
Private aExport := {}

cTable := CriaTrab(Nil,.F.)
SetRegua(MountTable(cTable))

While !(cTable)->(EOF())

//ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
//³ Verifica o cancelamento pelo usuario... ³
//ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

If lAbortPrint
@nLin,00 PSAY "*** CANCELADO PELO OPERADOR ***"
Exit
Endif

//ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
//³ Impressao do cabecalho do relatorio. . . ³
//ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
If nTipo = 18
If nLin > 55 // Salto de Página. Neste caso o formulario tem 55 linhas...
Cabec(Titulo,Cabec1,Cabec2,NomeProg,Tamanho,nTipo)
nLin := 8
Endif
Else
If nLin > 75 // Salto de Página. Neste caso o formulario tem 55 linhas...
Cabec(Titulo,Cabec1,Cabec2,NomeProg,Tamanho,nTipo)
nLin := 8
Endif
EndIf


@nLin,aCol[01] Psay (cTable)->D2_FILIAL
@nLin,aCol[02] Psay (cTable)->D1_FILIAL
@nLin,aCol[03] Psay STOD((cTable)->D2_EMISSAO)
@nLin,aCol[04] Psay (cTable)->D2_SERIE
@nLin,aCol[05] Psay (cTable)->D2_DOC
@nLin,aCol[6] Psay (cTable)->D2_COD
@nLin,aCol[7] Psay Transform((cTable)->D2_TOTAL,"@E 9,999,999.99")
@nLin,aCol[8] Psay (cTable)->D2_TES
@nLin,aCol[9] Psay (cTable)->D2_CF
@nLin,aCol[10] Psay (cTable)->D1_TES
@nLin,aCol[11] Psay (cTable)->D1_CF
@nLin,aCol[12] Psay STOD((cTable)->D1_DTDIGIT)
@nLin,aCol[13] Psay Transform((cTable)->D2_PICM,"@E 999.99")
@nLin,aCol[14] Psay Transform((cTable)->D1_PICM,"@E 999.99")
@nLin,aCol[15] Psay Transform((cTable)->D2_VALICM,"@E 999.99")
@nLin,aCol[16] Psay Transform((cTable)->D1_VALICM,"@E 999.99")
@nLin,aCol[17] Psay Transform((cTable)->DifICMS,"@E 999.99")

nLin := nLin + 1 // Avanca a linha de impressao

nSumT := (cTable)->DifICMS + nSumT
nSumTot := (cTable)->D2_TOTAL + nSumTot
nSumIcS := (cTable)->D2_VALICM + nSumIcS
nSumIcE := (cTable)->D1_VALICM + nSumIcE


(cTable)->(dbSkip()) // Avanca o ponteiro do registro no arquivo

//If(cProd <> (cTable)->D2_COD)
// lFlag := .T.
// nX := nX + 1
// @nLin,aCol[06] Psay PADC(nSumQ,10)
// nLin := nLin + 1 // Avanca a linha de impressao
// @nLin,01 Psay Replicate("-",135)
// nLin := nLin + 1 // Avanca a linha de impressao
// cProd := ""
// nSumQ := 0
//EndIf

EndDo

nLin := nLin + 1 // Avanca a linha de impressao
//@nLin,aCol[03] Psay "Total Produtos: " + ALLTRIM(STR(nX-1))
@nLin,aCol[04] Psay "Totais
>>>>>>>>"
@nLin,aCol[7]+1 Psay + Transform(nSumTot,"@E 9,999,999.99")
@nLin,aCol[15]+2 Psay + Transform(nSumIcS,"@E 999.99")
@nLin,aCol[16]+2 Psay + Transform(nSumIcE,"@E 999.99")
@nLin,aCol[17]+2 Psay + Transform(nSumT,"@E 999.99")
//nLin := nLin + 1 // Avanca a linha de impressao
//nLin := nLin + 1 // Avanca a linha de impressao
//nLin := nLin + 1 // Avanca a linha de impressao

//ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
//³ Finaliza a execucao do relatorio... ³
//ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

SET DEVICE TO SCREEN

If aReturn[5]==1
dbCommitAll()
SET PRINTER TO
OurSpool(wnrel)
Endif
MS_FLUSH()

Return

Static Function MountTable(cTable)
Local cQry := ""
Local cCampos := " D2_COD,D2_FILIAL,D2_CLIENTE,D2_LOJA,D1_FILIAL,D1_FORNECE,D1_LOJA,D2_EMISSAO,D2_SERIE,D2_DOC,D2_TOTAL, "
Local cCampos += " D2_TES,D2_CF,D1_TES,D1_CF,D1_DTDIGIT,D1_VALICM,D2_VALICM,DifICMS,D1_PICM,D2_PICM "
//Count(*) CONT
cQry += " Select Count(*) CONT From (
cQry += Chr(13) + Chr(10) + " Select D2_COD,D2_FILIAL,D2_CLIENTE,D2_LOJA,D1_FILIAL,D1_FORNECE,D1_LOJA,D2_EMISSAO,D2_SERIE,D2_DOC,D2_TOTAL,D2_TES,D2_CF,D1_TES,D1_CF,D1_DTDIGIT,D1_VALICM,D2_VALICM,D1_PICM,D2_PICM,SUM(D2_VALICM-D1_VALICM) AS DifICMS From " + RetSqlName("SD2") +" D2 "
cQry += Chr(13) + Chr(10) + " INNER JOIN " + RetSqlName("SD1") + " D1 ON D1.D1_DOC = D2.D2_DOC AND D1.D1_SERIE=D2.D2_SERIE AND D1.D1_COD=D2.D2_COD"
//cQry += Chr(13) + Chr(10) + " LEFT OUTER JOIN " + RetSqlName("SDB") + " DB ON DB_LOTECTL = D2_LOTECTL AND DB_PRODUTO = D2_COD AND DB_FILIAL = D2_FILIAL AND D2_SERIE = DB_SERIE and DB_ORIGEM = 'SC6' AND DB_DOC = D2_DOC AND DB.D_E_L_E_T_='' AND DB_ESTORNO='' "
cQry += Chr(13) + Chr(10) + " Where D2.D_E_L_E_T_ = ' ' AND D1.D_E_L_E_T_ = ' '"// AND D2_FILIAL = '" + XFILIAL("SD2") + "'"
cQry += Chr(13) + Chr(10) + " AND D2.D2_DOC BETWEEN '"+MV_PAR01+ "'AND '"+MV_PAR02+"'"
cQry += Chr(13) + Chr(10) + " AND D2.D2_SERIE BETWEEN '"+MV_PAR03+ "'AND '"+MV_PAR04+"'"
cQry += Chr(13) + Chr(10) + " AND D2.D2_EMISSAO BETWEEN '"+DTOS(MV_PAR05)+ "'AND '"+DTOS(MV_PAR06)+"'"
cQry += Chr(13) + Chr(10) + " AND D2.D2_FILIAL BETWEEN '"+MV_PAR07+ "'AND '"+MV_PAR08+"'"
cQry += Chr(13) + Chr(10) + " GROUP BY D2_COD,D2_FILIAL,D2_CLIENTE,D2_LOJA,D1_FILIAL,D1_FORNECE,D1_LOJA,D2_EMISSAO,D2_SERIE,D2_DOC,D2_TOTAL,D2_TES,D2_CF,D1_TES,D1_CF,D1_DTDIGIT,D1_VALICM,D2_VALICM,D1_PICM,D2_PICM "
//cQry += Chr(13) + Chr(10) + " AND D2_PEDIDO IN " + FormatIn( _Peds, "/") + " "
cQry += Chr(13) + Chr(10) + " )A

dbUseArea(.T.,"TOPCONN",TcGenQry(,,ChangeQuery(cQry)),cTable,.T.,.T.)
nCont := (cTable)->CONT
(cTable)->(dbCloseArea(cTable))
cQry := StrTran(cQry,"Count(*) CONT",cCampos)
cQry += Chr(13) + Chr(10) + " order by D2_SERIE, D2_DOC
dbUseArea(.T.,"TOPCONN",TcGenQry(,,ChangeQuery(cQry)),cTable,.T.,.T.)
MemoWrit("TransfHT.sql",cQry)

Return nCont


Static Function QuebraLin(nValQ)
Return .T.

//+
+
//! Função para criação das perguntas (se não existirem) !
//+
+
static function criaSX1(cPerg)

putSx1(cPerg, '01', 'Nota de?' , '', '', 'mv_ch1', 'C',9, 0, 0, 'G', '', '', '', '', 'mv_par01')
putSx1(cPerg, '02', 'Nota até?' , '', '', 'mv_ch2', 'C',9, 0, 0, 'G', '', '', '', '', 'mv_par02')
putSx1(cPerg, '03', 'Serie de?' , '', '', 'mv_ch3', 'C',3, 0, 0, 'G', '', '', '', '', 'mv_par03')
putSx1(cPerg, '04', 'Seie até?' , '', '', 'mv_ch4', 'C',3, 0, 0, 'G', '', '', '', '', 'mv_par04')
putSx1(cPerg, '05', 'Emissão de?' , '', '', 'mv_ch5', 'D',8, 0, 0, 'G', '', '' , '', '', 'mv_par05')
putSx1(cPerg, '06', 'Emissão até?' , '', '', 'mv_ch6', 'D',8, 0, 0, 'G', '', '' , '', '', 'mv_par06')
putSx1(cPerg, '07', 'Filial de?' , '', '', 'mv_ch7', 'C',2, 0, 0, 'G', '', 'SM0' , '', '', 'mv_par05')
putSx1(cPerg, '08', 'Filial até?' , '', '', 'mv_ch8', 'C',2, 0, 0, 'G', '', 'SM0' , '', '', 'mv_par06')

return NIL

Por favor Acessar ou Registrar para participar da conversa.

Tempo para a criação da página:0.068 segundos
Joomla templates by a4joomla