Ir ao conteúdo
  • Cadastre-se
Regras do Clube do Hardware

Word Código VBA para salvar folhas de ponto EM PDF, já agrupadas por FILIAL

rosanezane

Por rosanezane
em Microsoft Office e similares

 Compartilhar

Posts recomendados

rosanezane
 

rosanezane

Postado
Postado

Bom dia!

Gostaria de saber qual código VBA eu utilizo para salvar folhas de pontos de pessoas AGRUPADAS e renomeadas por filial. (formato PDF)

 

 

EXEMPLO:

 

EMPRESA CALIFORNIA.pdf (dentro do arquivo contem as 3 folhas de pontos dos funcionários)

EMPRESA SAO PAULO.pdf (dentro do arquivo contem as 2 folhas de pontos dos funcionários)

 

 

obs:

As filiais estão na planilha de excel.

 

 

 

 

 

_PADRÃO MAIO 2022.docx FUNCIONARIOS.xlsx

2 minutos atrás, rosanezane disse:

Bom dia!

Gostaria de saber qual código VBA eu utilizo para salvar folhas de pontos de pessoas AGRUPADAS e renomeadas por filial. (formato PDF)

 

 

EXEMPLO:

 

EMPRESA CALIFORNIA.pdf (dentro do arquivo contem as 3 folhas de pontos dos funcionários)

EMPRESA SAO PAULO.pdf (dentro do arquivo contem as 2 folhas de pontos dos funcionários)

 

 

obs:

As filiais estão na planilha de excel.

 

 

 

 

 

_PADRÃO MAIO 2022.docx 29 kB · 0 downloads FUNCIONARIOS.xlsx 95 kB · 0 downloads

@Basoleconsegue me ajudar nessa? 

Link para o comentário
Compartilhar em outros sites
rosanezane
 

rosanezane

Postado
  • Autor
Postado
1 hora atrás, Basole disse:

eu entendi que cada FOLHA DE FREQUÊNCIA FUNCIONAL de funcionários da MESMA EMPRESA, seja salvo em um unico documento no formato PDF.

Sim, @Basole

 

No caso, separados por filial conforme o quadro de excel que eu separei por cores no anexo. Já renomeados com o nome das empresas conforme você falou.

 

Geraria 4 arquivos de PDF:

 

Empresa California.pdf

Empresa Rio de Janeiro.pdf

Empresa São Paulo.pdf

Empresa Acre.pdf

 

 

 

filial.png

Link para o comentário
Compartilhar em outros sites
rosanezane
 

rosanezane

Postado
  • Autor
Postado
Em 10/05/2022 às 11:59, rosanezane disse:

Sim, @Basole

 

No caso, separados por filial conforme o quadro de excel que eu separei por cores no anexo. Já renomeados com o nome das empresas conforme você falou.

 

Geraria 4 arquivos de PDF:

 

Empresa California.pdf

Empresa Rio de Janeiro.pdf

Empresa São Paulo.pdf

Empresa Acre.pdf

 

E também já salvar em uma determinada pasta que eu escolher também

 

Em 10/05/2022 às 11:59, rosanezane disse:

 

 

 

filial.png

 

Link para o comentário
Compartilhar em outros sites
Midori
 

Midori

Postado
Postado

@rosanezane Para identificar o grupo de filiais, a macro pode ir selecionando os registros enquanto testa se o próximo é diferente do anterior. Para isso os dados da tabela do Excel devem estar ordenados por filial.

  

Sub CopiaFormulario()
    Dim DocumentoFilial As Document
    Dim Base            As MailMergeDataSource
    Dim Formulario      As Range
    Dim Filial          As String
    Dim FilialAnterior  As String
    Dim Conta           As Long
    
    Set Formulario = ThisDocument.Range
    Set Base = ThisDocument.MailMerge.DataSource   
    Base.ActiveRecord = wdFirstRecord
    
    For Conta = 1 To Base.RecordCount
        Filial = Base.DataFields("FILIAL").Value
        If FilialAnterior <> Filial Then
            Documents.Add
            Set DocumentoFilial = ActiveDocument
        End If
        Formulario.Start = Formulario.GoTo(wdGoToPage, wdGoToAbsolute, , 1).Start
        Formulario.Copy
        DocumentoFilial.Range.Characters.Last.Paste
        Base.ActiveRecord = wdNextRecord
        FilialAnterior = Filial
    Next Conta
End Sub

 

Teste com poucos registros porque a macro vai criar um documento para cada filial. Para salvar cada um em pdf tente usar PrintOut.

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites
rosanezane
 

rosanezane

Postado
  • Autor
Postado

@Midori com o seu código eu não consegui, mas com esse abaixo, sim. Foi uma mistura da primeira parte do seu código, com o código vba que o @Basole havia me fornecido uma outra vez.

 

Mas há um problema:  SÓ SALVA UMA FOLHA DE PONTO POR FILIAL ( um funcionário de cada empresa).  Alguém me help.

 

 

 

 

Sub SALVAR_AGRUPADO_PDF()

Dim Documento       As Document
    Dim NovoDocumento   As Document
    Dim Formulario      As Range
    Dim Filial          As String
    Dim FilialAnterior  As String
    Dim Conta           As Long

On Error GoTo tR_eRROR

Application.ScreenUpdating = False

With ActiveDocument.MailMerge.DataSource
.ActiveRecord = wdFirstRecord
End With

qtde = ActiveDocument.MailMerge.DataSource.RecordCount
strPath = "\\california\gestao_pessoas\DIVISAO DE LOTAÇÃO\2022\CONTRATO EMERGENCIAL - INDIVIDUAL\PRORROGAÇÃO 2022 PARTE 02\ATE DEZEMBRO\lab\" 'aqui é o caminho da pasta

For registro = 1 To qtde

nomeArquivo = ActiveDocument.MailMerge.DataSource.DataFields("FILIAL").Value

With ActiveDocument.MailMerge
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
        .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
    End With
    .Execute Pause:=False
End With

ActiveDocument.ExportAsFixedFormat OutputFileName:=strPath & nomeArquivo, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

Word.Application.DisplayAlerts = wdAlertsNone
ActiveWindow.Close SAVECHANGES:=False
Word.Application.DisplayAlerts = wdAlertsAll

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

Next registro

tR_eRROR:

Application.ScreenUpdating = True

End Sub

erro.png

só salva um.png

Link para o comentário
Compartilhar em outros sites
Basole
 

Basole

Postado
Postado

@rosanezane

No recurso da mala direta do Word, não encontrei nenhuma opção de agrupar novos documentos em um unico. 

A opção seria a de copiar e colar os docs criados individualmente em um unico documento, (como no exemplo do @Midori ), mas devido a dimensão dos dados, aqui pra mim, ao fazer isso as paginas não mantem a formatação original da Folha de Ponto, "pulando" para a pagina de baixo:

 

image.png.bf4fd96c74b68dbb4b118cb427353fab.png

 

Outra opção é salvar todos os documentos individuais em pdf, em seguida, atraves de utilitário agrupa-los de acordo com cada empresa.

 

Estou ajustando a macro e mais tarde posto aqui. 

 

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites
rosanezane
 

rosanezane

Postado
  • Autor
Postado
10 minutos atrás, Basole disse:

image.png.bf4fd96c74b68dbb4b118cb427353fab.png

 

@Basole desconsiderar a 2 pagina, acho que o excesso de caractere criou uma nova página no word.

o Certo é uma folha de ponto por funcionário, essas informações no final do word pode até apagar. Meu amigo eu aguardo ansiosamente para que você encontre alguma solução😕

  • Curtir 1
Link para o comentário
Compartilhar em outros sites
Midori
 

Midori

Postado
Postado
1 hora atrás, rosanezane disse:

@Midori Tentei com o seu código novamente, a planilha já estava vinculada, agora dá outro erro, valha🤕

 

Para dar esse erro o documento não deve estar vinculando.

 

Tente fechar o arquivo e ao abrir deve dar esta opção,

 

print.png.8c6fb5de274add19147bc498a1b14f1a.png

 

Escolha sim e procure a planilha.

 

Sobre a questão de criar outra página, isso pode ser resolvido ajustando o espaçamento das linhas.

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites
Midori
 

Midori

Postado
Postado

A macro completa que salva em pdf e ajusta as linhas para evitar colocar dados de uma página em outra,

 

A sub SalvaPDF está configurada para salvar os arquivos na pasta Downloads de User.

 

Para rodar é preciso configurar a base de dados do Excel, pode ser selecionando a planilha no disco como comentei acima ou em Mailings > Select Recipients > Use a Existing List. 

  

Sub CopiaFormulario()
    Dim DocumentoFilial As Document
    Dim Base            As MailMergeDataSource
    Dim Formulario      As Range
    Dim Filial          As String
    Dim FilialAnterior  As String
    Dim Conta           As Long
    
    Set Formulario = ThisDocument.Range
    Set Base = ThisDocument.MailMerge.DataSource
    Base.ActiveRecord = wdFirstRecord
    
    For Conta = 1 To Base.RecordCount
        Filial = Base.DataFields("FILIAL").Value
        If FilialAnterior <> Filial Then
            If Not DocumentoFilial Is Nothing Then
                Call SalvaPDF(FilialAnterior, DocumentoFilial)
            End If
            Documents.Add
            Set DocumentoFilial = ActiveDocument
        Else
            DocumentoFilial.Paragraphs.Add
        End If
        
        Formulario.Start = Formulario.GoTo(wdGoToPage, wdGoToAbsolute, , 1).Start
        Formulario.Copy
        DocumentoFilial.Range.Characters.Last.Paste
        
        With DocumentoFilial.Range.ParagraphFormat
            .SpaceAfter = 0
            .LineUnitAfter = 0
        End With
        
        Base.ActiveRecord = wdNextRecord
        FilialAnterior = Filial
    Next Conta
    
    If Not DocumentoFilial Is Nothing Then
        Call SalvaPDF(FilialAnterior, DocumentoFilial)
    End If
End Sub

Sub SalvaPDF(Nome As String, Documento As Document)
    Call Documento.ExportAsFixedFormat( _
        OutputFileName:=Environ("UserProfile") & "\Downloads\" & _
            Nome & ".pdf", _
        ExportFormat:=wdExportFormatPDF)
    Call Documento.Close(SaveChanges:=False)
End Sub

 

  • Curtir 2
Link para o comentário
Compartilhar em outros sites
  • 3 semanas depois...
rosanezane
 

rosanezane

Postado
  • Autor
Postado

@Basole @Midori desculpem a demora pra responder, tive uns imprevistos pessoais e fiquei ocupada com outras coisas.

 

O código dá erro "5852"

a mala direta já está configurada com lista de destinatários ( planilha)

mesmo assim o erro persiste. Será que tem haver com o endereço pra salvar?

abaixo o erro e a depuração

 

image.thumb.png.fb3408d54c73372ba2d8f335958e374d.png

image.png

abaixo , como vê, a planilha já está vinculada ao word.

 

image.thumb.png.48ca5fd72f6900bb99e4a88356c70883.png

Link para o comentário
Compartilhar em outros sites
Midori
 

Midori

Postado
Postado

@rosanezane Fiz umas modificações no código, veja se assim gera os arquivos. Para alterar o diretório onde os arquivos serão salvos é só editar a atribuição da variável Diretorio.

  

Sub CopiaFormulario()
    Dim Base            As MailMergeDataSource
    Dim DocumentoFilial As Document
    Dim Diretorio       As String
    Dim Filial          As String
    Dim FilialAnterior  As String
    Dim Conta           As Long
    
    Diretorio = Environ("UserProfile") & "\Downloads\"
    Set Base = ThisDocument.MailMerge.DataSource
    
    If Base.DataFields.Count > 0 And Dir(Diretorio, vbDirectory) <> "" Then
        Base.ActiveRecord = wdFirstRecord
    
        For Conta = 1 To Base.RecordCount
            Filial = Base.DataFields("FILIAL").Value
            If FilialAnterior <> Filial Then
                If Not DocumentoFilial Is Nothing Then
                    Call SalvaPDF(FilialAnterior, DocumentoFilial, Diretorio)
                End If
                Set DocumentoFilial = Documents.Add
            Else
                DocumentoFilial.Paragraphs.Add
            End If
            ThisDocument.Range.Copy
            DocumentoFilial.Range.Characters.Last.Paste
            DocumentoFilial.Range.ParagraphFormat.SpaceAfter = 0
            DocumentoFilial.Range.ParagraphFormat.LineUnitAfter = 0
            Base.ActiveRecord = wdNextRecord
            FilialAnterior = Filial
        Next Conta
        If Not DocumentoFilial Is Nothing Then
            Call SalvaPDF(FilialAnterior, DocumentoFilial, Diretorio)
        End If
    Else
        MsgBox "Erro ao configurar a base ou o diretório"
    End If
End Sub

Sub SalvaPDF(Nome As String, Documento As Document, Diretorio As String)
    Call Documento.ExportAsFixedFormat( _
        OutputFileName:=Diretorio & Nome & ".pdf", _
        ExportFormat:=wdExportFormatPDF)
    Call Documento.Close(SaveChanges:=False)
End Sub

 

  • Curtir 1
Link para o comentário
Compartilhar em outros sites
Midori
 

Midori

Postado
Postado

@rosanezane Se o diretório está certo então tem algum problema na conexão com o Excel. Você pode tentar fazer isso via macro, cole esta Sub no módulo.

  

Sub AbreBD(Planilha As String)
    ThisDocument.MailMerge.MainDocumentType = wdFormLetters
    ThisDocument.MailMerge.OpenDataSource _
        Name:=Planilha, ConfirmConversions:= _
        False, ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
        Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & Planilha & _
            ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" & _
            "Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database " _
            , SQLStatement:="SELECT * FROM `FUNCIONARIOS$`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
End Sub

 

Coloque a planilha FUNCIONARIOS.xlsx no mesmo diretório onde o PDF deve ser salvo (no seu caso é no Desktop) e chame o procedimento antes de atribuição da Base, 

Diretorio = "C:\Users\rosane.oliveira\Desktop\"
Call AbreBD(Diretorio & "\FUNCIONARIOS.xlsx")
Set Base = ThisDocument.MailMerge.DataSource

 

Link para o comentário
Compartilhar em outros sites
  • mês depois...
rosanezane
 

rosanezane

Postado
  • Autor
Postado

Eu desisto, mas obrigada pela paciência. Não deu aqui. Mesmo depois de muitos códigos e códigos. Anteriormente o @Basole havia feito uma planilha muito boa pra salvar individualmente utilizando uma determinada coluna como base de nome a ser salvo. Eu uso até hoje, inclusive.

 

Algumas vezes eu preciso enviar os arquivos para as Unidades, Infelizmente o  pessoal aqui reclamou porque são arquivos individuais , então ficavam abrindo pdf por pdf pra imprimir.  Se desse de fazer agrupado por empresa, ia ajudar muito na hora da impressão para eles.

 

No entanto eu não consegui utilizar os códigos acima, estão dando todos os erros possíveis.

Mas muito obrigada pela paciência @Midori

 

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora
 Compartilhar
Ir à lista de tópicos

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

Mais

×
×
  • Criar novo...

 

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!