Jump to content
Fórum Script Brasil
  • 0

Código VBA para gerar relatórios a partir de mala direta


Fernanda Marques de Araujo

Question

Olá. 

Eu gostaria de ajuda com um código VBA.

Há uns 2 anos atrás encontrei o código abaixo em um fórum na internet. Trata-se de um comando para gerar relatórios  a partir de mala direta (um relatório para cada linha da planilha Excel)

Eu executava esse código no WORD e ele gerava todos os relatórios a partir do meu modelo. Porém, atualmente está dando o seguinte erro ao executar: [Erro em tempo de Execução '5941': o membro solicitado da coleção não existe]

Alguém sabe como corrigir esse erro? ou então conhece algum outro código que atenda ao que eu preciso?

Obs: tenho muito pouco conhecimento em programação. HELP-ME

 

Código VBA:

Sub Laudos_Queimadas()
'
' Laudos_Queimadas
'
'
Application.ScreenUpdating = False
Dim qtde As Integer
Dim nomeArquivo As String
Dim registro As Integer
Dim nomearquivouniorg As String


ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

qtde = ActiveDocument.MailMerge.DataSource.RecordCount

For registro = 1 To qtde

nomeArquivo = ActiveDocument.MailMerge.DataSource.DataFields("A").Value
nomearquivouniorg = ActiveDocument.MailMerge.DataSource.DataFields("A").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.SaveAs2 FileName:="\\SRV-1383\estagiarios\TAREFAS_SAJ\QUEIMADAS\2024\IDs\LAUDOS\Laudo_nXXX_24_Pantanal_em_Alerta_ID_" & nomearquivouniorg & ".docx", FileFormat:= _
    wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
    :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
    :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
    SaveAsAOCELetter:=False, CompatibilityMode:=15
   
ActiveWindow.Close
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

Next registro
Application.ScreenUpdating = True
End Sub

Link to comment
Share on other sites

1 answer to this question

Recommended Posts

  • 0

Consegui configurar um código que gera todos os relatórios individuais (pedi ajuda ao chat GPT)

Sub SalvaDocumentosIndividuais()
    Const Caminho = "\\SRV-1383\estagiarios\TAREFAS_SAJ\QUEIMADAS\2024\LAUDOS\"
    Dim MainDoc As Document
    Dim NovoDoc As Document
    Dim i As Long
    Dim NomeArquivo As String
    Dim Identificador As String

    ' Definir o documento principal
    Set MainDoc = ActiveDocument

    ' Executar a mala direta para cada registro da fonte de dados
    For i = 2 To MainDoc.MailMerge.DataSource.recordCount
        ' Mover para o registro específico
        MainDoc.MailMerge.DataSource.ActiveRecord = i

        ' Obter o valor da coluna "A" (assumindo que é a primeira coluna)
        Identificador = MainDoc.MailMerge.DataSource.DataFields(1).Value

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

        ' Definir o nome do arquivo
        NomeArquivo = Caminho & "Laudo_nXXX_24_Pantanal_em_Alerta_ID-" & Identificador & ".docx"

        ' Salvar o documento como .docx
        Set NovoDoc = ActiveDocument
        NovoDoc.SaveAs2 fileName:=NomeArquivo, FileFormat:=wdFormatXMLDocument
        NovoDoc.Close False

        ' Limpar a referência ao novo documento
        Set NovoDoc = Nothing
    Next i

    ' Limpar a referência ao documento principal
    Set MainDoc = Nothing

    MsgBox "Documentos salvos com sucesso!"
End Sub
 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      152.1k
    • Total Posts
      651.9k
×
×
  • Create New...