none
Macro Word Substituir RRS feed

  • Pergunta

  • Prezados:

    Utilizo a macro abaixo para alterar a formatação de vários arquivos de forma automática.

    Seria possível adaptar para fazer substituições?

    Ou seja, procura em c:\word\, todos os arquivos que ali tiver, abre um por um, procura a palavra a ser substituída, se encontrar faz a substituição, salva e fecha.

    Grato

    AdrianoPires

    Sub pMain()
      'Altere aqui o caminho do diretório que contém os arquivos que você quer formatar.
      Const csDiretório As String = "c:\WORD\"
     
      Dim doc As Word.Document
      Dim oFile As Object 'Scripting.File
      Dim oFolder As Object 'Scripting.Folder
      Dim oFSO As Object 'Scripting.FileSystemObject
     
      Set oFSO = CreateObject("Scripting.FileSystemObject")
      Set oFolder = oFSO.GetFolder(csDiretório)
      For Each oFile In oFolder.Files
        If LCase(oFSO.GetExtensionName(oFile.Path)) Like "doc*" Then
          Set doc = Documents.Open(oFile.Path)
          doc.Content.Select
          Selection.Style = doc.Styles(wdStyleNormal)
          Selection.Font.Color = wdColorBlack
          Selection.Font.Bold = False
          Selection.Font.Italic = False
          Selection.Font.Size = 11
          Selection.Font.Name = "ARIAL"
          Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
          doc.PageSetup.TopMargin = 25
          doc.PageSetup.BottomMargin = 25
          doc.PageSetup.LeftMargin = 25
          doc.PageSetup.RightMargin = 25
          doc.ActiveWindow.ActivePane.View.Zoom.Percentage = 78
          doc.Close SaveChanges:=wdSaveChanges
          DoEvents
        End If
      Next oFile
    End Sub

    quinta-feira, 26 de novembro de 2015 16:05

Respostas

  • Sub Main()
        'Altere aqui o caminho do diretório que contém os arquivos que você quer formatar.
        Const csDiretório As String = "c:\WORD\"
      
        Dim doc As Word.Document
        Dim oFile As Object 'Scripting.File
        Dim oFolder As Object 'Scripting.Folder
        Dim oFSO As Object 'Scripting.FileSystemObject
      
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oFolder = oFSO.GetFolder(csDiretório)
        For Each oFile In oFolder.Files
            If Not LCase(oFSO.GetExtensionName(oFile.Path)) Like "doc*" Then GoTo Continue
            Set doc = Documents.Open(oFile.Path)
            Selection.Find.Execute FindText:="Texto Procurado", _
                                   ReplaceWith:="Text Substituído", _
                                   Replace:=wdReplaceAll, _
                                   Wrap:=wdFindContinue
            doc.Close SaveChanges:=wdSaveChanges
            DoEvents
    Continue:
        Next oFile
    End Sub


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    • Sugerido como Resposta André Santo segunda-feira, 30 de novembro de 2015 13:16
    • Marcado como Resposta AdrianoPires segunda-feira, 30 de novembro de 2015 18:19
    segunda-feira, 30 de novembro de 2015 12:44
    Moderador

Todas as Respostas

  • Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum. Uma janela aparecerá onde você deverá colar seu código cru na caixa de texto à esquerda. Então, selecione a opção Vb.Net na caixa de combinação que você verá em cima à esquerda e depois clique no botão Inserir.

    ---

    Sobre seu código, ele já faz o que você quer, não?


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    quinta-feira, 26 de novembro de 2015 21:53
    Moderador
  • Felipe,

    Obrigado pela atenção, quanto ao código não sabia dessa regra, me desculpe.

    Esse código não faz o quero, ele faz a formatação do arquivo, tamanho da letra, alinhamento,zoom, etc.

    O que quero é que faça substituição de palavras de forma automática.

    Ou seja, que vá na pasta indicada, abra arquivo por arquivo, substitua a palavra estabelecida,salve o arquivo e feche, como este código faz com a formatação.

    Agrqadeco se puder ajudar.

    AdrianoPires


    sexta-feira, 27 de novembro de 2015 01:38
  • Já tentou isso?

    Sub pMain()
      'Altere aqui o caminho do diretório que contém os arquivos que você quer formatar.
      Const csDiretório As String = "c:\WORD\"
      
      Dim doc As Word.Document
      Dim oFile As Object 'Scripting.File
      Dim oFolder As Object 'Scripting.Folder
      Dim oFSO As Object 'Scripting.FileSystemObject
      
      Set oFSO = CreateObject("Scripting.FileSystemObject")
      Set oFolder = oFSO.GetFolder(csDiretório)
      For Each oFile In oFolder.Files
        If LCase(oFSO.GetExtensionName(oFile.Path)) Like "doc*" Then
          Set doc = Documents.Open(oFile.Path)
            Selection.Find.Execute FindText:="Texto Procurado", _
                                   ReplaceWith:="Text Substituído", _
                                   Wrap:=wdFindContinue
          DoEvents
        End If
      Next oFile
    End Sub


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    sexta-feira, 27 de novembro de 2015 16:15
    Moderador
  • Felipe,

    É isso mesmo, mas o código só procura uma vez no documento e faz a substituição.

    Acontece que nos documentos o "Texto Procurado" aparece diversas vezes e o código só faz a verificação na primeira vez que aparece, as demais não faz.

    Tem como fazer a primeira alteração e continuar procurando?

    Não estava salvando e fechando, mas inclui a linha doc.Close SaveChanges:=wdSaveChanges e está ok.

    Grato

    AdrianoPires

    sexta-feira, 27 de novembro de 2015 17:43
  • Sub Main()
        'Altere aqui o caminho do diretório que contém os arquivos que você quer formatar.
        Const csDiretório As String = "c:\WORD\"
      
        Dim doc As Word.Document
        Dim oFile As Object 'Scripting.File
        Dim oFolder As Object 'Scripting.Folder
        Dim oFSO As Object 'Scripting.FileSystemObject
      
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oFolder = oFSO.GetFolder(csDiretório)
        For Each oFile In oFolder.Files
            If Not LCase(oFSO.GetExtensionName(oFile.Path)) Like "doc*" Then GoTo Continue
            Set doc = Documents.Open(oFile.Path)
            Selection.Find.Execute FindText:="Texto Procurado", _
                                   ReplaceWith:="Text Substituído", _
                                   Replace:=wdReplaceAll, _
                                   Wrap:=wdFindContinue
            doc.Close SaveChanges:=wdSaveChanges
            DoEvents
    Continue:
        Next oFile
    End Sub


    http://www.ambienteoffice.com.br - http://www.clarian.com.br

    • Sugerido como Resposta André Santo segunda-feira, 30 de novembro de 2015 13:16
    • Marcado como Resposta AdrianoPires segunda-feira, 30 de novembro de 2015 18:19
    segunda-feira, 30 de novembro de 2015 12:44
    Moderador
  • Boa Tarde Felipe,

    Funcionou direitinho.

    Obrigado pela ajuda.

    AdrianoPires

    segunda-feira, 30 de novembro de 2015 18:19