Relatório de Clientes por Vendedor

Sabemos que não dá pra resolver tudo...a culpa não é sua!
Converse com a gente ali na caixa ao lado 👉

Olá pessoal!

Segue um relatório muito útil, para listar todos os clientes quebrando por vendedor.

//Bibliotecas
#Include "Protheus.ch"
#Include "TopConn.ch"
	
//Constantes
#Define STR_PULA		Chr(13)+Chr(10)
	
/*/{Protheus.doc} FBFATR01
Relatório - Clientes por vendedor         
@author FBSolutions
@since 24/04/2017
@version 1.0
	@example
	u_FBFATR01()
/*/
	
User Function FBFATR01()
	Local aArea   := GetArea()
	Local oReport
	Local lEmail  := .F.
	Local cPara   := ""
	Private cPerg := ""
	
	//Definições da pergunta
	cPerg := "FBFATR01  "

	ValidPerg()
	If !Pergunte(cPerg, .t.)
		Return .f.
	EndIf
	
	//Se a pergunta não existir, zera a variável
	DbSelectArea("SX1")
	SX1->(DbSetOrder(1)) //X1_GRUPO + X1_ORDEM
	If ! SX1->(DbSeek(cPerg))
		cPerg := Nil
	EndIf
	
	//Cria as definições do relatório
	oReport := fReportDef()
	
	//Será enviado por e-Mail?
	If lEmail
		oReport:nRemoteType := NO_REMOTE
		oReport:cEmail := cPara
		oReport:nDevice := 3 //1-Arquivo,2-Impressora,3-email,4-Planilha e 5-Html
		oReport:SetPreview(.F.)
		oReport:Print(.F., "", .T.)
	//Senão, mostra a tela
	Else
		oReport:PrintDialog()
	EndIf
	
	RestArea(aArea)
Return
	
/*-------------------------------------------------------------------------------*
 | Func:  fReportDef                                                             |
 | Desc:  Função que monta a definição do relatório                              |
 *-------------------------------------------------------------------------------*/
	
Static Function fReportDef()
	Local oReport
	Local oSectDad1 := Nil
	Local oSectDad2 := Nil
	Local oBreak := Nil
	
	//Criação do componente de impressão
	oReport := TReport():New(	"LAFATR01",;		//Nome do Relatório
								"Clientes por vendedor",;		//Título
								cPerg,;		//Pergunte ... Se eu defino a pergunta aqui, será impresso uma página com os parâmetros, conforme privilégio 101
								{|oReport| fRepPrint(oReport)},;		//Bloco de código que será executado na confirmação da impressão
								)		//Descrição
	oReport:SetTotalInLine(.F.)
	oReport:lParamPage := .F.
	oReport:oPage:SetPaperSize(9) //Folha A4
	oReport:SetLandscape()
	
	//Criando a seção de dados
	oSectDad1 := TRSection():New(	oReport,;		//Objeto TReport que a seção pertence
									"Agrupador",;		//Descrição da seção
									{"QRY_AUX"})		//Tabelas utilizadas, a primeira será considerada como principal da seção
	oSectDad1:SetTotalInLine(.F.)  //Define se os totalizadores serão impressos em linha ou coluna. .F.=Coluna; .T.=Linha
	
	//Colunas do relatório
	TRCell():New(oSectDad1, "A3_COD", "QRY_AUX", "Codigo", /*Picture*/, 6, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)
	TRCell():New(oSectDad1, "A3_NOME", "QRY_AUX", "Nome", /*Picture*/, 50, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)
	
	//Criando a seção de dados								
	oSectDad2 := TRSection():New(	oReport,;		//Objeto TReport que a seção pertence
									"Dados",;		//Descrição da seção
									{"QRY_AUX"})		//Tabelas utilizadas, a primeira será considerada como principal da seção
	oSectDad2:SetTotalInLine(.F.)  //Define se os totalizadores serão impressos em linha ou coluna. .F.=Coluna; .T.=Linha
	
	//Colunas do relatório
	TRCell():New(oSectDad2, "A1_COD", "QRY_AUX", "Codigo", /*Picture*/, 6, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)
	TRCell():New(oSectDad2, "A1_LOJA", "QRY_AUX", "Loja", /*Picture*/, 2, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)
	TRCell():New(oSectDad2, "A1_NOME", "QRY_AUX", "Nome", /*Picture*/, 50, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)
	TRCell():New(oSectDad2, "A1_EST", "QRY_AUX", "Estado", /*Picture*/, 2, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)
	TRCell():New(oSectDad2, "A1_MUN", "QRY_AUX", "Municipio", /*Picture*/, 30, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)
	TRCell():New(oSectDad2, "A1_TEL", "QRY_AUX", "Telefone", /*Picture*/, 15, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)
	TRCell():New(oSectDad2, "A1_ULTCOM", "QRY_AUX", "Últ.Compra", /*Picture*/, 12, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)
        //Adicione mais campos, caso necessário
	
	//Definindo a quebra
	oBreak := TRBreak():New(oSectDad1,{|| QRY_AUX->(A3_COD) },{|| "Total Vendedor" })
	oSectDad1:SetHeaderBreak(.T.)
	
	//Definindo a quebra
	oBreak1 := TRBreak():New(oSectDad2,{|| QRY_AUX->(A3_COD) },{|| "Total Vendedor" })
	oSectDad2:SetHeaderBreak(.T.)
	
	oSectDad2:SetHeaderSection(.T.)
	
	//Totalizadores
	oFunTot1 := TRFunction():New(oSectDad2:Cell("A1_COD"),,"COUNT",oBreak,,"@E 9999")
	oFunTot1:SetEndReport(.F.)
	
     //Aqui, farei uma quebra  por seção
	//oSectDad1:SetPageBreak(.T.)
	//oSectDad1:SetTotalText(" ")			
	
Return oReport
	
/*-------------------------------------------------------------------------------*
 | Func:  fRepPrint                                                              |
 | Desc:  Função que imprime o relatório                                         |
 *-------------------------------------------------------------------------------*/
	
Static Function fRepPrint(oReport)
	Local aArea    := GetArea()
	Local cQryAux  := ""
	Local oSectDad1 := Nil
	Local oSectDad2 := Nil
	Local nAtual   := 0
	Local nTotal   := 0
	Local cVend    := ""
	
	//Pegando as seções do relatório
	oSectDad1 := oReport:Section(1)
	oSectDad2 := oReport:Section(2)
	
	//Montando consulta de dados
	cQryAux := ""
	cQryAux += "SELECT A1_COD, A1_LOJA, A1_NOME, A1_EST, A1_MUN, A1_TEL, A3_COD, A3_NOME, A1_ULTCOM FROM SA1010 SA1"		+ STR_PULA
	cQryAux += "		 INNER JOIN SA3010 SA3 ON ( SA1.A1_VEND = SA3.A3_COD AND SA3.D_E_L_E_T_ = ' ' )"		+ STR_PULA
	cQryAux += "WHERE SA1.D_E_L_E_T_ = ' ' "		+ STR_PULA
	cQryAux += "AND SA3.A3_COD BETWEEN '" + MV_PAR01 + "' AND " + MV_PAR02 + " "		+ STR_PULA
	cQryAux += "AND SA1.A1_MSBLQL <> '1'"		+ STR_PULA
	cQryAux += "ORDER BY A3_COD, A1_NOME"		+ STR_PULA
	cQryAux := ChangeQuery(cQryAux)
	
	//Executando consulta e setando o total da régua
	TCQuery cQryAux New Alias "QRY_AUX"
	Count to nTotal
	oReport:SetMeter(nTotal)
	TCSetField("QRY_AUX", "A1_ULTCOM", "D")
	
	//Enquanto houver dados
	//oSectDad1:Init()
	QRY_AUX->(DbGoTop())
	While ! QRY_AUX->(Eof())
	
		If oReport:Cancel()
			Exit
		EndIf
	
		//inicializo a primeira seção
		oSectDad1:Init()
			
		//Incrementando a régua
		nAtual++
		oReport:SetMsgPrint("Imprimindo registro "+cValToChar(nAtual)+" de "+cValToChar(nTotal)+"...")
		oReport:IncMeter()
		
		cVend := QRY_AUX->(A3_COD)
		
		//Imprimindo a linha atual
		oSectDad1:PrintLine()
		
		oSectDad2:Init()
		
		While QRY_AUX->(A3_COD) == cVend
		
			nAtual++
			oReport:SetMsgPrint("Imprimindo registro "+cValToChar(nAtual)+" de "+cValToChar(nTotal)+"...")
			oReport:IncMeter()
			oSectDad2:Printline()
		
			QRY_AUX->(DbSkip())
		EndDo	
	EndDo
	oSectDad1:Finish()
	oSectDad2:Finish()
	QRY_AUX->(DbCloseArea())
	
	RestArea(aArea)
Return

Static Function ValidPerg()
	Local aArea:= GetArea()                                                                                                                          
	Local aRegs
	Local i, j
	
	DbSelectArea("SX1")
	DbSetOrder(1)
	cPerg:= Padr(cPerg, 10)
	
	aRegs:= {}
	aAdd(aRegs, {cPerg,"01","Vendedor De          ?","","","mv_ch1","C",06,0,0,"G","","mv_par01","","","","","","","","","","","","","","","","","","","","","","","","","SA3","","","","",""})
	aAdd(aRegs, {cPerg,"02","Vendedor Até         ?","","","mv_ch2","C",06,0,0,"G","","mv_par02","","","","","","","","","","","","","","","","","","","","","","","","","SA3","","","","",""})
		
	For i:= 1 To Len(aRegs)
		If !DbSeek(cPerg + aRegs[i,2])
			RecLock("SX1", .t.)
			For j:= 1 To fCount()
				FieldPut(j, aRegs[i,j])
			Next j
			MsUnlock()
			DbCommit()
		Endif
	Next i
		
	RestArea(aArea)		
Return

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

//Bibliotecas

#Include "Protheus.ch"

#Include "TopConn.ch"

//Constantes

#Define STR_PULA Chr(13)+Chr(10)

/*/{Protheus.doc} FBFATR01

Relatório - Clientes por vendedor

@author FBSolutions

@since 24/04/2017

@version 1.0

@example

u_FBFATR01()

/*/

User Function FBFATR01()

Local aArea := GetArea()

Local oReport

Local lEmail := .F.

Local cPara := ""

Private cPerg := ""

//Definições da pergunta

cPerg := "FBFATR01 "

ValidPerg()

If !Pergunte(cPerg, .t.)

Return .f.

EndIf

//Se a pergunta não existir, zera a variável

DbSelectArea("SX1")

SX1->(DbSetOrder(1)) //X1_GRUPO + X1_ORDEM

If ! SX1->(DbSeek(cPerg))

cPerg := Nil

EndIf

//Cria as definições do relatório

oReport := fReportDef()

//Será enviado por e-Mail?

If lEmail

oReport:nRemoteType := NO_REMOTE

oReport:cEmail := cPara

oReport:nDevice := 3 //1-Arquivo,2-Impressora,3-email,4-Planilha e 5-Html

oReport:SetPreview(.F.)

oReport:Print(.F., "", .T.)

//Senão, mostra a tela

Else

oReport:PrintDialog()

EndIf

RestArea(aArea)

Return

/*-------------------------------------------------------------------------------*

| Func: fReportDef |

| Desc: Função que monta a definição do relatório |

*-------------------------------------------------------------------------------*/

Static Function fReportDef()

Local oReport

Local oSectDad1 := Nil

Local oSectDad2 := Nil

Local oBreak := Nil

//Criação do componente de impressão

oReport := TReport():New( "LAFATR01",; //Nome do Relatório

"Clientes por vendedor",; //Título

cPerg,; //Pergunte ... Se eu defino a pergunta aqui, será impresso uma página com os parâmetros, conforme privilégio 101

{|oReport| fRepPrint(oReport)},; //Bloco de código que será executado na confirmação da impressão

) //Descrição

oReport:SetTotalInLine(.F.)

oReport:lParamPage := .F.

oReport:oPage:SetPaperSize(9) //Folha A4

oReport:SetLandscape()

//Criando a seção de dados

oSectDad1 := TRSection():New( oReport,; //Objeto TReport que a seção pertence

"Agrupador",; //Descrição da seção

{"QRY_AUX"}) //Tabelas utilizadas, a primeira será considerada como principal da seção

oSectDad1:SetTotalInLine(.F.) //Define se os totalizadores serão impressos em linha ou coluna. .F.=Coluna; .T.=Linha

//Colunas do relatório

TRCell():New(oSectDad1, "A3_COD", "QRY_AUX", "Codigo", /*Picture*/, 6, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)

TRCell():New(oSectDad1, "A3_NOME", "QRY_AUX", "Nome", /*Picture*/, 50, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)

//Criando a seção de dados

oSectDad2 := TRSection():New( oReport,; //Objeto TReport que a seção pertence

"Dados",; //Descrição da seção

{"QRY_AUX"}) //Tabelas utilizadas, a primeira será considerada como principal da seção

oSectDad2:SetTotalInLine(.F.) //Define se os totalizadores serão impressos em linha ou coluna. .F.=Coluna; .T.=Linha

//Colunas do relatório

TRCell():New(oSectDad2, "A1_COD", "QRY_AUX", "Codigo", /*Picture*/, 6, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)

TRCell():New(oSectDad2, "A1_LOJA", "QRY_AUX", "Loja", /*Picture*/, 2, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)

TRCell():New(oSectDad2, "A1_NOME", "QRY_AUX", "Nome", /*Picture*/, 50, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)

TRCell():New(oSectDad2, "A1_EST", "QRY_AUX", "Estado", /*Picture*/, 2, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)

TRCell():New(oSectDad2, "A1_MUN", "QRY_AUX", "Municipio", /*Picture*/, 30, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)

TRCell():New(oSectDad2, "A1_TEL", "QRY_AUX", "Telefone", /*Picture*/, 15, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)

TRCell():New(oSectDad2, "A1_ULTCOM", "QRY_AUX", "Últ.Compra", /*Picture*/, 12, /*lPixel*/,/*{|| code-block de impressao }*/,/*cAlign*/,/*lLineBreak*/,/*cHeaderAlign */,/*lCellBreak*/,/*nColSpace*/,/*lAutoSize*/,/*nClrBack*/,/*nClrFore*/,/*lBold*/)

//Adicione mais campos, caso necessário

//Definindo a quebra

oBreak := TRBreak():New(oSectDad1,{|| QRY_AUX->(A3_COD) },{|| "Total Vendedor" })

oSectDad1:SetHeaderBreak(.T.)

//Definindo a quebra

oBreak1 := TRBreak():New(oSectDad2,{|| QRY_AUX->(A3_COD) },{|| "Total Vendedor" })

oSectDad2:SetHeaderBreak(.T.)

oSectDad2:SetHeaderSection(.T.)

//Totalizadores

oFunTot1 := TRFunction():New(oSectDad2:Cell("A1_COD"),,"COUNT",oBreak,,"@E 9999")

oFunTot1:SetEndReport(.F.)

//Aqui, farei uma quebra por seção

//oSectDad1:SetPageBreak(.T.)

//oSectDad1:SetTotalText(" ")

Return oReport

/*-------------------------------------------------------------------------------*

| Func: fRepPrint |

| Desc: Função que imprime o relatório |

*-------------------------------------------------------------------------------*/

Static Function fRepPrint(oReport)

Local aArea := GetArea()

Local cQryAux := ""

Local oSectDad1 := Nil

Local oSectDad2 := Nil

Local nAtual := 0

Local nTotal := 0

Local cVend := ""

//Pegando as seções do relatório

oSectDad1 := oReport:Section(1)

oSectDad2 := oReport:Section(2)

//Montando consulta de dados

cQryAux := ""

cQryAux += "SELECT A1_COD, A1_LOJA, A1_NOME, A1_EST, A1_MUN, A1_TEL, A3_COD, A3_NOME, A1_ULTCOM FROM SA1010 SA1" + STR_PULA

cQryAux += " INNER JOIN SA3010 SA3 ON ( SA1.A1_VEND = SA3.A3_COD AND SA3.D_E_L_E_T_ = ' ' )" + STR_PULA

cQryAux += "WHERE SA1.D_E_L_E_T_ = ' ' " + STR_PULA

cQryAux += "AND SA3.A3_COD BETWEEN '" + MV_PAR01 + "' AND " + MV_PAR02 + " " + STR_PULA

cQryAux += "AND SA1.A1_MSBLQL <> '1'" + STR_PULA

cQryAux += "ORDER BY A3_COD, A1_NOME" + STR_PULA

cQryAux := ChangeQuery(cQryAux)

//Executando consulta e setando o total da régua

TCQuery cQryAux New Alias "QRY_AUX"

Count to nTotal

oReport:SetMeter(nTotal)

TCSetField("QRY_AUX", "A1_ULTCOM", "D")

//Enquanto houver dados

//oSectDad1:Init()

QRY_AUX->(DbGoTop())

While ! QRY_AUX->(Eof())

If oReport:Cancel()

Exit

EndIf

//inicializo a primeira seção

oSectDad1:Init()

//Incrementando a régua

nAtual++

oReport:SetMsgPrint("Imprimindo registro "+cValToChar(nAtual)+" de "+cValToChar(nTotal)+"...")

oReport:IncMeter()

cVend := QRY_AUX->(A3_COD)

//Imprimindo a linha atual

oSectDad1:PrintLine()

oSectDad2:Init()

While QRY_AUX->(A3_COD) == cVend

nAtual++

oReport:SetMsgPrint("Imprimindo registro "+cValToChar(nAtual)+" de "+cValToChar(nTotal)+"...")

oReport:IncMeter()

oSectDad2:Printline()

QRY_AUX->(DbSkip())

EndDo

oSectDad1:Finish()

oSectDad2:Finish()

QRY_AUX->(DbCloseArea())

RestArea(aArea)

Return

Static Function ValidPerg()

Local aArea:= GetArea()

Local aRegs

Local i, j

DbSelectArea("SX1")

DbSetOrder(1)

cPerg:= Padr(cPerg, 10)

aRegs:= {}

aAdd(aRegs, {cPerg,"01","Vendedor De ?","","","mv_ch1","C",06,0,0,"G","","mv_par01","","","","","","","","","","","","","","","","","","","","","","","","","SA3","","","","",""})

aAdd(aRegs, {cPerg,"02","Vendedor Até ?","","","mv_ch2","C",06,0,0,"G","","mv_par02","","","","","","","","","","","","","","","","","","","","","","","","","SA3","","","","",""})

For i:= 1 To Len(aRegs)

If !DbSeek(cPerg + aRegs[i,2])

RecLock("SX1", .t.)

For j:= 1 To fCount()

FieldPut(j, aRegs[i,j])

Next j

MsUnlock()

DbCommit()

Endif

Next i

RestArea(aArea)

Return

Se você é iniciante no Protheus, veja como é fácil cadastrar um cliente aqui.

Help do cadastro de clientes

Leave a Reply Cancelar resposta