Histórico da Página

01. DADOS GERAIS

Produto:

Solucoes_totvs

Solucao	TOTVS Prestadores de Serviços Terceirização

Solucoes_totvs_cross

SolucaoCross

Solucoes_totvs_parceiros

SolucaoParceiros

Solucoes_totvs_parceirosexptotvs

SolucaoParcsExpsTOTVS

Linha de Produto:

Linhas_totvs

Linha	Linha Protheus

Segmento:

Segmentos_totvs

Segmento	Serviços

Módulo:

Prestadores de Serviços

Função:

TECR894 - Termo de entrega

País:

Brasil

Ticket:

Não há.

Requisito/Story/Issue (informe o requisito relacionado) :

DSERSGS-11271

02. SITUAÇÃO/REQUISITO

A rotina de geração de termo de entrega de uniformes não possui ponto de entrada para que haja maior flexibilidade na customização dos documentos gerados.

03. SOLUÇÃO

A função abaixo deve ser copiada e colada em um arquivo ".PRW" com nome "At894Doc" e compilada no ambiente.

Para facilitar, no código abaixo existem 3 trechos com "/*/--ADICIONAR CAMPOS AQUI-- /*/", esses trechos informam os locais onde devem ser adicionados os campos desejados, seguindo a lógica onde primeiramente precisam estar na Query SQL (Para para buscar as informações no banco), logo mais a baixo abaixo, para cada campo novo na query deve ser criado uma posição nova no array(aDadosImp) iniciando na posição 5, logo temos aDadosImp[1][5]... aDadosImp[1][6] e assim consecutivamente. Mais abaixo devemos adicionar cada campo no OLE_SetDocumentVar(oWord, "VARIAVEL_CAMPO" , aDadosImp[nCountA, "POSICAO_CAMPOS"]), onde a VARIAVEL_CAMPO define o conteúdo da variável presente no documento modelo, e POSICAO_CAMPOS é a posição onde esse registro se encontra no array aDadosImp.

Aviso

title	Importante

É altamente recomendado Recomendamos que um desenvolvedor ADVPL manipule e compile a função abaixo para garantir ofuncionamento o funcionamento do requisito. O arquivo TECR894.ch esta disponível para download na aba "Demais Informações"

Bloco de código

language	text

#INCLUDE 'TOTVS.CH'
#INCLUDE 'MSOLE.CH'
#INCLUDE 'TECR894.CH'
 
Static aItens   := {} //Array com os itens de Reimpressão selecionados
 
//------------------------------------------------------------------------------
/*/{Protheus.doc} At894Doc
IMpressão do Termo de entrega/*/
//------------------------------------------------------------------------------
User Function At894Doc()
Local lOk           := .F.
Local aSays         := {}
Local aButtons      := {}
Local aParams       := {}
Local cFuncDe       := TXC->TXC_CODTEC
Local cFuncAte      := TXC->TXC_CODTEC
Local cPathServer   := Alltrim(SuperGetMv("MV_TECPATH"))    //Diretorio que estao os DOTS originais
 
//Parametros para seleção utilizados na impressão
aAdd(aParams, {3, STR0001   , 1, {STR0002, STR0003}, 90,, .T.})     //-- MV_PAR01
aAdd(aParams, {3, STR0004   , 1, {STR0005, STR0006}, 90,, .T.})     //-- MV_PAR02
aAdd(aParams, {3, STR0007   , 1, {STR0008, STR0009}, 100,, .T.})    //-- MV_PAR03
 
If ParamBox(aParams, STR0013)//'Parâmetros'
    // -----------------------------------------------------
    // Dialogo principal para parametrizacao
    // -----------If Len(PARAMIXB) > 0
	/* *********************************************************
	Estrutura do array para impressão
	aItens :=	{
					CÓDIGO_ATENDENTE (CARACTER),
					NOME_ATENDENTE (CARACTER),
					CPF_ATENDENTE (CARACTER),
					{
						CÓDIGO_UNIFORME (CARACTER),
						DESCRIÇÃO_UNIFORME (CARACTER),
						QUANTIDADE_UNIFORME (CARACTER),
						DATA_VALIDADE_UNIFORME (CARACTER),
					}
				}
	********************************************************* */
	aItens := PARAMIXB[1]
EndIf

//Parametros para seleção utilizados na impressão
aAdd(aParams, {3, STR0001   , 1, {STR0002, STR0003}, 90,, .T.})     //-- MV_PAR01
aAdd(aParams, {3, STR0004   , 1, {STR0005, STR0006}, 90,, .T.})     //-- MV_PAR02
aAdd(aParams, {3, STR0007   , 1, {STR0008, STR0009}, 100,, .T.})    //-- MV_PAR03
 
If ParamBox(aParams, STR0013)//'Parâmetros'
    // -----------------------------------------------------
    AAdd(aSays, STR0010// Dialogo principal para parametrizacao
    // -----------------------------------------------------
    AAdd(aSays, STR0010)
    AAdd(aSays, STR0011)
    AAdd(aSays, STR0012 + cPathServer)
    AAdd(aButtons, {5, .T., {|| ParamBox(aParams, STR0013)}})
    AAdd(aButtons, {1, .T., {|o| lOk := .T.,o:oWnd:End()}})
    AAdd(aButtons, {2, .T., {|o| o:oWnd:End()}})
 
    FormBatch(STR0014, aSays, aButtons,,, 650)
 
    If lOk
        Processa({|lEnd| AtR894Prc(@lEnd,cFuncDe,cFuncAte,cPathServer)}, STR0015, STR0016, .T.)
    EndIf
EndIf
 
Return
 
//------------------------------------------------------------------------------
/*/{Protheus.doc} AtR894Prc
Realiza a impressão do documento
 
@author     Serviços
@since      11/06/2019
@version    P12.1.23
/*/
///*/
//------------------------------------------------------------------------------
Static Function AtR894Prc(lEnd,cFuncDe,cFuncAte,cPathServer)
Local cAliasQry  := ''
Local lContinua  := .T.
Local cArqModel  := ''
Local cExtension := ''
Local cPathDest  := ''
Local cDestino   := MV_PAR01
Local cSaveAs    := MV_PAR02
Local cVersWord  := MV_PAR03
Local aDadosImp  := {}
Local nCountA    := 0
Local nCountB    := 0
Local nPosA      := 0
Local lRHProt   := SuperGetMv("MV_GSXINT",.F., "2") == "2"
Local cArqTemp := ""
Local cNewFile := ""
Local cTempPath := GetTempPath()
 
// --------------------------------------------
// TRATA A VERSAO DO MS WORD
// --------------------------------------------
If cVersWord == 1
    cArqModel := cPathServer + 'TECR894.DOT'
    //-- Se a versao do Ms Word for a 97/2003 nao permite
    //-- a saida do relatorio em PDF
    If cSaveAs == 1
        Aviso(STR0017, STR0018, {STR0019}, 2)//'Não é possível realizar a geração do documento no formato "PDF" para versao 97/2003 do Microsoft Word. O formato do documento será reajustado para "DOC"'
        cSaveAs := 2
    EndIf
Else
    cArqModel   := cPathServer + 'TECR894.DOTM'
EndIf
 
 
// ---------------------------------------
// VERIFICA SE O ARQUIVO "MODELO" EXISTE
// ---------------------------------------
If !File(cArqModel)
    lContinua := .F.
    Aviso(STR0017, STR0020 + cArqModel + STR0021, {STR0019}, 2)//'O arquivo ',' não existe! Entre em contato com o Administrador do sistema.'
EndIf
 
 
// ---------------------------------------
// TRATA GRAVACAO EM DISCO
// ---------------------------------------
If lContinua
    If cDestino == 2
        cExtension := If(cSaveAs == 1, '*.PDF', If(cVersWord == 1, '*.DOC', '*.DOCX'))
        cPathDest  := Alltrim(cGetFile(STR0022 + cExtension + '|' + cExtension +'|' , STR0023, 1, '', .T., GETF_LOCALHARD+GETF_RETDIRECTORY,.F.))
        If Empty(cPathDest)
            Aviso(STR0017, STR0024, {STR0019}, 2)
            lContinua := .F.
        Else
            lContinua := ChkPerGrv(cPathDest)
            If !lContinua
                Aviso(STR0017, STR0025, {STR0019}, 2)
            EndIf
        EndIf
    Endif
EndIf
 
 
// ------------------------------------------------
// TRANSFERE MODELO WORD DO SERVIDOR P/ ESTACAO
// ------------------------------------------------
If lContinua
    If !CpyS2T(cArqModel, AllTrim(cTempPath))
        lContinua := .F.
        Aviso(STR0017, STR0026, {STR0019}, 2)
    Else
        // --------------------------------------------------------
        // SE CONSEGUIU TRANSFERIR O ARQUIVO, RENOMEIA O MESMO
        // PARA PREVENIR, EM CASO DE ERRO, O TRAVAMENTO DO ARQUIVO
        // DE MODELO
        // --------------------------------------------------------
        cArqTemp  := GetNextAlias() + If(cVersWord == 1, '.dot', '.dotm')
 
        FRename(AllTrim(cTempPath) + If(Right(AllTrim(cTempPath), 1) == '\', '', '\') + 'TECR894' + If(cVersWord == 1, '.dot', '.dotm'),;
                AllTrim(cTempPath) + If(Right(AllTrim(cTempPath), 1) == '\', '', '\') + cArqTemp)
 
        cArqTemp := AllTrim(cTempPath) + If(Right(AllTrim(cTempPath), 1) == '\', '', '\') + cArqTemp
 
    EndIf
EndIf
 
// ------------------------------------------
// IMPRESSAO DO DOCUMENTO
// ------------------------------------------
If lContinua .And. 
	If Empty(aItens)
    		// ------------------------------------------
    		// PROCESSA QUERY PARA IMPRESSAO DO DOCUMENTO
    		// ------------------------------------------
    		cAliasQry := GetNextAlias()
    		BeginSQL Alias cAliasQry
        SELECT TXD.TXD			SELECT TXD.TXD_CODTEC, AA1.AA1_NOMTEC , SRA.RA_CIC, TXD.TXD_CODPRO, SB1.B1_DESC, TXD.TXD_QTDE, TXD.TXD_DTVAL /*/--ADICIONAR CAMPOS AQUI-- /*/
          			FROM %Table:TXD% TXD
          			JOIN %Table:AA1% AA1
            				ON AA1.AA1_FILIAL = %xFilial:AA1%
           			AND AA1.AA1_CODTEC = TXD.TXD_CODTEC
           			AND AA1.%NotDel%
          			LEFT JOIN %Table:SRA% SRA
            				ON SRA.RA_FILIAL = %xFilial:SRA%
           			AND SRA.RA_MAT = AA1.AA1_CDFUNC
           			AND SRA.%NotDel%
          			JOIN %Table:SB1% SB1
            				ON SB1.B1_FILIAL = %xFilial:SB1%
           			AND SB1.B1_COD = TXD.TXD_CODPRO
           			AND SB1.%NotDel%
         			WHERE TXD.TXD_FILIAL = %xFilial:TXD%
           			AND TXD.TXD_CODTEC BETWEEN %Exp:cFuncDe% AND %Exp:cFuncAte%
           			AND TXD.TXD_DTENTR <> ' '
           			AND TXD.%NotDel%
    		EndSQL
 
    	
		If !(cAliasQry)->(Eof())
        			While !(cAliasQry)->(Eof())
            				nPosA := aScan(aDadosImp, {|x| x[1] == (cAliasQry)->TXD_CODTEC})
            				If nPosA == 0
                					aAdd(aDadosImp, {(cAliasQry)->TXD_CODTEC, (cAliasQry)->AA1_NOMTEC, IIF(lRHProt, Transform((cAliasQry)->RA_CIC, PesqPict('SRA', 'RA_CIC')), ""), {} /*/--ADICIONAR CAMPOS AQUI-- /*/})
                nPosA 					nPosA := Len(aDadosImp)
            EndIf
                				EndIf
					aAdd(aDadosImp[nPosA, 4], { AllTrim((cAliasQry)->TXD_CODPRO),;
                												AllTrim((cAliasQry)->B1_DESC),;
												Transform((cAliasQry)->TXD_QTDE, PesqPict('TXD', 'TXD_QTDE')),;
												DtoC(StoD((cAliasQry)->TXD_DTVAL)) })                               AllTrim((cAliasQry)->B1_DESC),;
                                            Transform((cAliasQry)->TXD_QTDE, PesqPict('TXD', 'TXD_QTDE')),;
                                            DtoC(StoD((cAliasQry)->TXD_DTVAL)) })                               
            (cAliasQry)->(DbSkip())
        End
         
        (cAliasQry)->(DbSkip())
         
        For nCountA := 1 To Len(aDadosImp)
            //-- Arquivo que sera gerado:
            cNewFile := cPathDest + If(Right(cPathDest, 1) == '\', '', '\') + DtoS(dDataBase) + '_' + StrTran(Time(), ':', '') + '_TECR894' + StrTran(cExtension, '*', '')
 
            // --------------------------------------
            // ESTABELECE COMUNICACAO COM O MS WORD
            // --------------------------------------
            oWord := OLE_CreateLink()
            OLE_SetProperty(oWord, oleWdVisible, .F.)
            If oWord == "-1"
                Aviso(STR0017, STR0027, {STR0019}, 2)
                Exit
            Else
 
                // -----------------------------------
                // CARREGA MODELO
                // -----------------------------------
                OLE_NewFile(oWord, Alltrim(cArqTemp))
 
                // -------------------------------------------
                // REALIZA O PROCESSO DE MACRO SUBSTITUICAO
                // DOS CAMPOS DO MODELO WORD
                // -------------------------------------------
                OLE_SetDocumentVar(oWord, 'cNomeFunc'       , aDadosImp[nCountA, 2])
                OLE_SetDocumentVar(oWord, 'cCPF'            , aDadosImp[nCountA, 3])
 
                For nCountB := 1 To Len(aDadosImp[nCountA, 4])
                    OLE_SetDocumentVar(oWord, 'cCodigo' + AllTrim(Str(nCountB))     , aDadosImp[nCountA, 4, nCountB, 1])                   
                    OLE_SetDocumentVar(oWord, 'cDescr' + AllTrim(Str(nCountB))      , aDadosImp[nCountA, 4, nCountB, 2])
                    OLE_SetDocumentVar(oWord, 'nQtde' + AllTrim(Str(nCountB))       , aDadosImp[nCountA, 4, nCountB, 3])
                    OLE_SetDocumentVar(oWord, 'dDtValidade' + AllTrim(Str(nCountB)) , aDadosImp[nCountA, 4, nCountB, 4])
                Next nCountB
 
                OLE_SetDocumentVar(oWord, 'nItens', AllTrim(Str(Len(aDadosImp[nCountA, 4]))))
                OLE_ExecuteMacro(oWord, "mcrUniformes")
 
                /*/--ADICIONAR CAMPOS AQUI-- /*/
                /*/--OLE_SetDocumentVar(oWord, **CAMPOS**           , aDadosImp[nCountA, **nCAMPOS**])-- /*/

                //-- Atualiza os campos
                OLE_UpDateFields(oWord)
 
                //-- Determina a saida do relatorio:
                If cDestino == 1
 
				(cAliasQry)->(DbSkip())
			End
		Else
			lContinua := .F.
			MsgAlert(STR0029)
		EndIf

		(cAliasQry)->(DbCloseArea())
	Else
		aDadosImp := aClone( aItens )
	EndIf

	For nCountA := 1 To Len(aDadosImp)
		//-- Arquivo que sera gerado:
		cNewFile := cPathDest + If(Right(cPathDest, 1) == '\', '', '\') + DtoS(dDataBase) + '_' + StrTran(Time(), ':', '') + '_TECR894' + StrTran(cExtension, '*', '')

		// --------------------------------------
		// ESTABELECE COMUNICACAO COM O MS WORD
		// --------------------------------------
		oWord := OLE_CreateLink()
		OLE_SetProperty(oWord, oleWdVisible, .F.)
		If oWord == "-1"
			Aviso(STR0017, STR0027, {STR0019}, 2)
			Exit
		Else

			// -----------------------------------
			// CARREGA MODELO
			// -----------------------------------
			OLE_NewFile(oWord, Alltrim(cArqTemp))

			// -------------------------------------------
			// REALIZA O PROCESSO DE MACRO SUBSTITUICAO
			// DOS CAMPOS DO MODELO WORD
			// -------------------------------------------
			OLE_SetDocumentVar(oWord, 'cNomeFunc'       , aDadosImp[nCountA, 2])
			OLE_SetDocumentVar(oWord, 'cCPF'                   OLE_PrintFile(oWord, cNewFile,,, 1)
         , aDadosImp[nCountA, 3])

			For nCountB := 1 To Len(aDadosImp[nCountA, 4])
				OLE_SetDocumentVar(oWord, 'cCodigo' + AllTrim(Str(nCountB))     , aDadosImp[nCountA, 4,    Sleep(1000)
nCountB, 1])                Else
   
				OLE_SetDocumentVar(oWord, 'cDescr'     + AllTrim(Str(nCountB))      , aDadosImp[nCountA, 4,   nCountB, 2])
				OLE_SaveAsFileSetDocumentVar(oWord, cNewFile,,,, If(cSaveAs == 1, '17', NIL)) //--Parametro '17' salva em pdf
                Endif
 
                //--Fecha link com MS-Word
 'nQtde' + AllTrim(Str(nCountB))       , aDadosImp[nCountA, 4, nCountB, 3])
				OLE_SetDocumentVar(oWord, 'dDtValidade' + AllTrim(Str(nCountB)) , aDadosImp[nCountA, 4, nCountB, 4])
			Next nCountB

			OLE_SetDocumentVar(oWord, 'nItens', AllTrim(Str(Len(aDadosImp[nCountA, 4]))))
			OLE_ExecuteMacro(oWord, "mcrUniformes")

			/*/--ADICIONAR CAMPOS AQUI-- /*/
			/*/--OLE_SetDocumentVar(oWord, **CAMPOS**           , aDadosImp[nCountA,   OLE_CloseFile(oWord)
                OLE_CloseLink(oWord)
            EndIf
 
        End
        MsgInfo(STR0028)
 
    Else
        MsgAlert(STR0029)
 
    EndIf
     
EndIf**nCAMPOS**])-- /*/

			//-- Atualiza os campos
			OLE_UpDateFields(oWord)

			//-- Determina a saida do relatorio:
			If cDestino == 1
				OLE_PrintFile(oWord, cNewFile,,, 1)
				Sleep(1000)
			Else
				OLE_SaveAsFile(oWord, cNewFile,,,, If(cSaveAs == 1, '17', NIL)) //--Parametro '17' salva em pdf
			Endif

			//--Fecha link com MS-Word
			OLE_CloseFile(oWord)
			OLE_CloseLink(oWord)
		EndIf
	Next nCountA

	If lContinua
		MsgInfo(STR0028)
	EndIf
EndIf

//-- Exclui arquivo modelo na estacao:
FErase(cArqTemp)
 
//Limpa a Variavel
aItens := {}
 
Return
 
//------------------------------------------------------------------------------
/*/{Protheus.doc} ChkPerGrv
Checa permissao de gravacao na pasta indicada para geracao
do relatorio
 
@author     Serviços
@since      11/06/2019
@version    P12.1.23
/*/
//------------------------------------------------------------------------------
Static Function ChkPerGrv(cPath)
Local cFileTmp := CriaTrab(NIL, .F.)
Local nHdlTmp  := 0
Local lRet     := .F.
 
cPath   := AllTrim(cPath)
nHdlTmp := MSFCreate(cPath + If(Right(cPath, 1) <> '\', '\', '') + cFileTmp + '.TMP', 0)
If nHdlTmp <= 0
    lRet := .F.
Else
    lRet := .T.
    FClose(nHdlTmp)
    FErase(cPath + If(Right(cPath, 1) <> '\', '\', '') + cFileTmp + '.TMP')
EndIf
 
Return(lRet)

04. DEMAIS INFORMAÇÕES

...

View file
name tecr894.ch
height 250

05. ASSUNTOS RELACIONADOS

Gestão de Uniformes - TECA894 - Gestão de Serviços - P12#2026436566

...

Árvore de páginas

Versões comparadas

Versão antiga 16

Nova versão Atual

Chave

01. DADOS GERAIS

02. SITUAÇÃO/REQUISITO

03. SOLUÇÃO

04. DEMAIS INFORMAÇÕES

View file
name tecr894.ch
height 250

05. ASSUNTOS RELACIONADOS

Árvore de páginas

Histórico da Página

Versões comparadas

Versão antiga 16

Nova versão Atual

Chave

01. DADOS GERAIS

02. SITUAÇÃO/REQUISITO

03. SOLUÇÃO

04. DEMAIS INFORMAÇÕES

View filenametecr894.chheight250

05. ASSUNTOS RELACIONADOS

View file
name tecr894.ch
height 250