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?
-
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.– DavidCommented 21/07/2016 às 9:59
-
2Blz! vou fazer essa alteração– Micael FerreiraCommented 21/07/2016 às 13:04
4 Respostas
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
-
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. Commented 5/08/2016 às 11:14
-
1Sobre 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. :) Commented 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. Commented 8/08/2016 às 21:54
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
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
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
-
Isso é uma resposta ou apenas o código pronto? muito incompleto... Commented 22/01/2018 às 19:48