Alterar Rodapé com Macro

[danielbasiliocw]

Pessoal, boa tarde.

Estou com varios arquivos aqui que precisam ser alterados os rodapes. 

Eu encontrei uma macro no proprio forum porém ela nao altera a formatacao. A macro é esta:

 

 

Sub rodape2()
'
' rodape2 Macro
' cdfdfd
 ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter '......7
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = _
            "Métrica TopoEVN Fácil 6.9.2.14 - Sistema profissional para cálculos, desenhos e projetos topográficos.    -    tecnologia Métrica TopoEVN Fácil 6.9.2.14® 2013"
        
'3º) DIGITE TELEFONE E E-MAIL DA NOVA LOJA
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        .Replacement.Text = "GO-070, KM 126 o Meio Rural o Goiás o GO o CEP: 76600-000 \n Telefones o (62) 3372-1720 o (62) 9693-2686 o www.terrasreunidas.com.br"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        
        
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
Sub Macro4()
Call Padronizacao
Call ENDERECO_NEW
Call rodape2
'On Error Resume Next
End Sub

 

Vejam a imagem de como estão os documentos e abaixo com a seta indicativa como deveria ficar.

Como eu coloco as quebras de texto e se possivel o numero de pagina? A linha acima do texto pode nao aparecer...

Poderia ser na verdade uma macro que copia um rodape de um arquivo modelo e repassa para os documentos selecionados... Alguem consegue me ajudar?

[danielbasiliocw]

Consegui pessoal, pra quem precisar esta ai o codigo, isso é possivel pra varios arquivos juntei com outro codigo e deu certo, eu nao sei nada de VBA mas deu certo kkkkk

se puderem adptar pra copiar cabeçalho e rodape de uma vez seria bom!

 

Sub CommandButton1_Click()
Dim MyDialog As FileDialog, GetStr(1 To 100) As String '100 files is the maximum applying this code
On Error Resume Next
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.docx", 1
.AllowMultiSelect = True
i = 1
If .Show = -1 Then
For Each stiSelectedItem In .SelectedItems
GetStr(i) = stiSelectedItem
i = i + 1
Next
i = i - 1
End If
Application.ScreenUpdating = False
For j = 1 To i Step 1

    Dim docTemplate As Document
    Dim strTemplate As String
    Dim hdr1 As HeaderFooter
    Dim hdr2 As HeaderFooter
    Dim doc As Document
    
    Set doc = Documents.Open(FileName:=GetStr(j), Visible:=True)
Windows(GetStr(j)).Activate
    strTemplate = "C:\ModuloVBA\papeltimbrado.dot"
    Set docTemplate = Documents.Open(strTemplate)
    Set hdr1 = docTemplate.Sections(1).Footers(wdHeaderFooterPrimary)
    Set hdr2 = doc.Sections(1).Footers(wdHeaderFooterPrimary)
    hdr1.Range.Copy
    hdr2.Range.Paste
    docTemplate.Close False

Next
Application.ScreenUpdating = True
End With
If Documents.Count > 0 Then
    Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
End Sub