3

PessoALL, o meu caso é o seguinte: Eu participo da organização de alguns eventos na área de TI e software livre e a impressão de certificados é sempre um problema. No último evento que participei como organizador a missão era emitir os certificados de maneira digital, gerando um arquivo PDF para cada certificado. Como eu posso dividir uma mala direta em arquivos diferentes, com nomes personalizados e em PDF?

2
  • Micael, poderia transformar seu texto acima em pergunta, e então adicionar uma resposta no local de resposta, juntamente com código na descrição, sem o link. Assim fica no padrão do site, e mais fácil ser compreendido.
    – David
    21/07/2016 às 9:59
  • 2
    Blz! vou fazer essa alteração 21/07/2016 às 13:04

4 Respostas 4

3

Então a solução que eu encontrei foi o usar VBA for application. As instruções:

1- Criar a mala direta no Word com o nome dos participantes e outras informações que forem necessárias.

2- Mesclar a mala direta de modo que o resultado final seja um arquivo do Word com todos os certificados.

3- No arquivo com todos os certificados, escrever o seguinte código VBA:

Sub BreakOnSection()
Dim Arquivo As Integer
Dim CaminhoArquivo As String
Dim TextoProximaLinha As String

'Set reading the file that contains the names of files that will be generated.
Arquivo = FreeFile
CaminhoArquivo = "F:\Documentos\Evento\participantes.txt"

'Open file for reading.
Open CaminhoArquivo For Input As Arquivo

'Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection

'A mail merge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)   
    'Note: If a document does not end with a section break,
    'substitute the following line of code for the one above:
    'For I = 1 To ActiveDocument.Sections.Count

    'Select and copy the section text to the clipboard.
    ActiveDocument.Bookmarks("\Section").Range.Copy

    'Create a new document to paste text from clipboard.
    Documents.Add
    Selection.Paste

    'Altera a orientação da página para paisagem
    Orientation
    'Deletes the last page (use only if necessary)
    DeleteLastLine

    'Removes the break that is copied at the end of the section, if any.
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
    ChangeFileOpenDirectory "F:\Documentos\Evento\Certificados\"

    'It makes the line reading
    Line Input #Arquivo, TextoProximaLinha
    TextoProximaLinha = TextoProximaLinha

    'Export to .pdf and customize the file name to the line that was read
     ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    "F:\Documentos\Evento\Certificados\" & TextoProximaLinha & ".pdf" _
    , 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

    'Closes the "temporary" file from Word without saving changes
    ActiveDocument.Close savechanges:=wdDoNotSaveChanges
    'Move the selection to the next section in the document.
    Application.Browser.Next
Next i
        ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Sub Orientation()
    'If the page orientation is portrait in it is changed to landscape
    'This is a particular case in issuing certificates. Make sure that in your case there is a need
    If Selection.PageSetup.Orientation = wdOrientPortrait Then
        Selection.PageSetup.Orientation = wdOrientLandscape
    Else
    Selection.PageSetup.Orientation = wdOrientPortrait
    End If
ActiveWindow.ActivePane.VerticalPercentScrolled = 0
End Sub

Sub DeleteLastLine()
'This is a particular case in issuing certificates. Make sure that in your case there is a need
    Selection.HomeKey Unit:=wdStory
    Selection.EndKey Unit:=wdStory
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
End Sub

4- Executar e ser feliz! =D

3
  • Vc já ganhou o meu +1 porque a sua resposta tem bastante potencial de ser útil para outras pessoas. Mas, só faltaram duas coisinhas importantes. (1) Traduzir os comentários do código. Esse site é o StackOverflow em Português, de modo que ter os comentários no nosso idioma seria bastante importante. (2) Como os comentários estão em inglês, eu entendo que você copiou o código de algum lugar. Nesse caso é correto e justo você informar a fonte original. 5/08/2016 às 11:14
  • 1
    Sobre o item 2, eu notei agora que um colega comentou em uma versão anterior da sua pergunta para que você respondesse à própria pergunta. Ótimo que o fez! :) O colega disse pra tirar o link. Enfim, o que eu quis dizer é pra deixar também o link (na resposta), pois nesse ponto eu discordo do colega: a referência da fonte original é igualmente importante. :) 5/08/2016 às 11:17
  • É verdade que eu não fiz tudo, esse código é resultado de duas fontes mais a minha contribuição. Eu deixei tudo em inglês, por que eu postei esse código no minha conta do github e lá é bastante comum que as postagens sejam em inglês, já que o github funciona como uma vitrine e o inglês é requisito muito importante na nossa área. O link que o colega falou era o meu link para o meu repositório. Mesmo assim concordo com você sobre estarmos em um fórum em português. Farei a alteração assim que possível. 8/08/2016 às 21:54
0

Não precisa desse código todo meu caro.

Basta criar esse código abaixo no documento mestre e executá-lo.

Lembrete: o primeiro campo da mala direta deve ser o nome do aluno ou deve mudar para o número correto da sua base de dados no código (Nome = ActiveDocument.MailMerge.DataSource.DataFields.Item(1).Value) para o nome correto.

Código

Sub GeraCertificadoPDF()
'
' Macro GeraCertificadoPDF
' Gera arquivos em pdf a partir de mala direta via VBA
'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
    For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount

        Nome = ActiveDocument.MailMerge.DataSource.DataFields.Item(1).Value

        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        "c:\temp\Certificados\" & Nome & ".pdf" _
        , 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

        ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

    Next i
End Sub
0

Tive uma necessidade parecida, então adaptei alguns códigos e os transformei em dois: um deles salva em .docx (Macro 1) e o outro em .pdf (Macro 2), ambos geram arquivos individuais e com o nome da coluna que você escolher, basta adicionar o código no arquivo mestre.

Macro 1:

Sub SalvarComoDOCIndividual()

Dim a As Integer

Dim registro As Integer

Dim nomeArquivo As String

'Define o primeiro registro da mala direta

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

'Contador de registros

a = ActiveDocument.MailMerge.DataSource.RecordCount

'Salva todos os registros

For registro = 1 To a

    'Atribui o valor de cada registro da coluna nome para a variável nomeArquivo que dará nome ao novo arquivo. Caso queira outro nome, basta colocar o nome da coluna desejada
    nomeArquivo = ActiveDocument.MailMerge.DataSource.DataFields("Nome").Value 

    ActiveDocument.SaveAs2 FileName:= _
        "C:\Users\Lera\Desktop\" & nomeArquivo & ".docx", FileFormat:= _
    wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
    :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
    :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
    SaveAsAOCELetter:=False, CompatibilityMode:=15

    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

    Next registro

    End

End Sub


'Trocar C:\Users\Lera\Desktop\ pelo caminho da pasta onde será salvo os arquivos gerados

Macro 2:

Sub SalvarComoPDF()

Dim a As Integer

Dim registro As Integer

Dim nomeArquivo As String

'Define o primeiro registro da mala direta

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

'Contador de registros

a = ActiveDocument.MailMerge.DataSource.RecordCount

'Exporta todos os registros

For registro = 1 To a

    'Atribui o valor de cada registro da coluna nome para a variável nomeArquivo que dará nome ao novo arquivo. Caso queira outro nome, basta colocar o nome da coluna desejada
    nomeArquivo = ActiveDocument.MailMerge.DataSource.DataFields("Nome").Value 

    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        "C:\Users\Lera\Desktop\" & nomeArquivo & ".pdf" _
        , 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

    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

    Next registro

    End

End Sub


'Trocar C:\Users\Lera\Desktop\ pelo caminho da pasta onde será salvo os arquivos gerados
-3
Sub Macro1()

 Macro1 Macro
 Cria PDF de mala direta do word 2016

Set Mail Merge in the first register
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
Mail Merge Count
qtde = 94
qtde = ActiveDocument.MailMerge.DataSource.RecordCount
arquivo = ActiveDocument.MailMerge.DataSource.FieldNames(1).Name
nome = "Nome do seu arquivo" & ActiveDocument.MailMerge.DataSource.DataFields("nickname").Value
Do While qtde > 0
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    "D:\dir1\subdir1\subdir2\subdir3\" & nome & ".pdf", 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
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
nome = "Nome do seu arquivo" & ActiveDocument.MailMerge.DataSource.DataFields("nickname").Value
qtde = qtde - 1
Loop
End Sub
1
  • Isso é uma resposta ou apenas o código pronto? muito incompleto... 22/01/2018 às 19:48

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .