segunda-feira, 18 de dezembro de 2017
DVD
ConteÚdo
DOWNLOADS
Interação
dicas aleatórias
Dicas

Salvar cada documento gerado pela mala direta como arquivo separado
Autor:  Osmar Jr. (osmar@ativoaccess.com.br)
Publicado:  28/07/2008
Visitas: 
 
Salvar cada documento gerado pela mala direta como arquivo separado

Normalmente a mala direta resulta em um novo documento que é um grande arquivo que pode ser editado e/ou impresso. Usando a propriedade Documento Mestre é possível salvar cada um como um arquivo separado. No documento resultante da junção, cada registro é criado em sua própria seção e podemos transformar cada uma dessas seções em um sub-documento, abri-lo e salvá-lo como um documento separado.

A única preparação necessária é, no documento principal da junção, selecionar o primeiro parágrafo, ir em Formatar => Parágrafo e deixar o Nível do Tópico igual a Nível 1. A propriedade Documento Mestre necessita disso para criar o sub-documento.

O código VBA abaixo ajuda a automatizar o processo:

CODE
Sub SalvaComo Arqs
' Converte todas as seções para subdocumentos
TudoParaSubDocs ActiveDocument
' Salva cada subdocumento como um arquivo separado
SalvaTodosSubDocs ActiveDocument
End Sub



CODE
Sub TudoParaSubDocs(ByRef doc As Word.Document)
Dim ctaSec As Long
Dim NrSecs As Long
NrSecs = doc.Sections.Count
' Inicial pelo final porque a criação de
' Subdocs iinsere seções adicionais
For ctaSec = NrSecs - 1 To 1 Step -1
doc.Subdocuments.AddFromRange doc.Sections(ctaSec).Range
Next ctaSec
End Sub



CODE
Sub SalvaTodosSubDocs(ByRef doc As Word.Document)
Dim subdoc As Word.Subdocument
Dim NovoDoc As Word.Document
Dim ContaDocs As Long
ContaDocs = 1
' Deve estar em Exibir Mestre para trabalhar com
' Subdocs como arquivos separados
doc.ActiveWindow.View = wdMasterView
For Each subdoc In doc.Subdocuments
Set NovoDoc = subdoc.Open
' Remove as quebras de seção Próxima Página
' Geradas pela fusão dos arquivos
RemoveQuebrasSec NovoDoc
With NovoDoc
.SaveAs FileName:="Arquivo" & CStr(ContaDocs)
.Close
End With
ContaDocs = ContaDocs + 1
Next subdoc
End Sub



CODE
Sub RemoveQuebrasSec(doc As Word.Document)
With doc.Range.Find
.ClearFormatting
.Text = "^b"
With .Replacement
.ClearFormatting
.Text = ""
End With
.Execute Replace:=wdReplaceAll
End With
End Sub

  « Voltar

   Copyright © Ativo Access 2003 - 2017- Todos os direitos reservados   Política de Privacidade | Fale conosco