Notifications
Clear all

Código para executar macro em vários docs

6 Posts
2 Usuários
0 Reactions
1,309 Visualizações
(@cmalves)
Posts: 16
Active Member
Topic starter
 

Olá
Caros colegas
Tenho uma macro que executa outras três. Gostaria de criar uma rotina para inserir o caminho/nome de vários documentos a serem aplicados esta mesma macro (são cerca de 210 documentos do word).
Obs: Esta macro altera o cabeçalho e o rodapé dos documentos word da lista dos 210 modelos que preciso alterar constantemente.
Lembrando aos colegas que sou leigo no assunto e fiz a macro com ajuda da internet e exemplos encontrados.
Se puderem também simplificá-las, agradeço
segue documento
No aguardo
Obrigado a todos
CLOVIS

 
Postado : 12/02/2014 6:01 pm
(@cmalves)
Posts: 16
Active Member
Topic starter
 

Olá
Caros colegas
Tenho uma macro que executa outras três. Gostaria de criar uma rotina para inserir o caminho/nome de vários documentos a serem aplicados esta mesma macro (são cerca de 210 documentos do word).
Obs: Esta macro altera o cabeçalho e o rodapé dos documentos word da lista dos 210 modelos que preciso alterar constantemente.
Lembrando aos colegas que sou leigo no assunto e fiz a macro com ajuda da internet e exemplos encontrados.
Se puderem também simplificá-las, agradeço
segue documento
No aguardo
Obrigado a todos
CLOVIS

NÃO ESTOU CONSEGUINDO ADAPTAR O CÓDIGO QUE ENCONTREI
Fonte: http://www.biblesupport.com/topic/1633- ... -a-folder/

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub DoLangesNow()
Dim file
Dim spath As String

' Path to your folder. MY folder is listed below. I bet yours is different.
' make SURE you include the terminating ""
'YOU MUST EDIT THIS.
spath = "C:UsersPJCDesktopClovis"

'Change this file extension to the file you are opening. .htm is listed below. You may have rtf or docx.
'YOU MUST EDIT THIS.
file = Dir(spath & "*.doc")
Do While file <> ""
Documents.Open FileName:=spath & file

' This is the call to the macro you want to run on each file the folder
'YOU MUST EDIT THIS. lange01 is my macro name. You put yours here.
Call Padronizacao
Call ENDERECO_NEW
Call rodape2
Call Macro4

' Saves the file
ActiveDocument.Save
ActiveDocument.Close
' set file to next in Dir
file = Dir()
Loop
End Sub

Sub Padronizacao()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "1ª DP - CENTRO / RONDONÓPOLIS"
.Replacement.Text = "LOJA DALAS"
.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 ENDERECO_NEW()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find '..................................................10
.Text = "AVENIDA CANADÁ" '11

'2º) DIGITE ENDEREÇO DA NOVA LOJA
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.Replacement.Text = "AVENIDA ESTADOS UNIDOS " '...12
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

.Forward = True '..............13
.Wrap = wdFindContinue '.......14
.Format = False '..............15
.MatchCase = False '...........16
.MatchWholeWord = False '......17
.MatchWildcards = False '......18
.MatchSoundsLike = False '.....19
.MatchAllWordForms = False '...20
End With '...................................................21
Selection.Find.Execute Replace:=wdReplaceAll '...........22
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '...........23 adicionado
End Sub '..............................................................24 adicionado
Sub rodape2()
'
' rodape2 Macro
' cdfdfd
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter '......7
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = _
"Fone:55 (65)1233-5414 - E-mail: @clovis.gov.br">virtuas@clovis.gov.br CEP: 78010-200"

'3º) DIGITE TELEFONE E E-MAIL DA NOVA LOJA
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
.Replacement.Text = "Fone:55 (65)4747-7895 - E-mail: @clovis.gov.br">best@clovis.gov.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
'ActiveDocument.Protect Password:="123", NoReset:=False, Type:=wdAllowOnlyFormFields
'On Error Resume Next
If ActiveDocument.Saved = False Then ActiveDocument.Save
Application.Quit SaveChanges:=wdPromptToSaveChanges
End Sub

 
Postado : 14/02/2014 2:43 pm
(@gtsalikis)
Posts: 2373
Noble Member
 

cmalves,

Eu andei tentando fazer umas macros pra Word, e acho meio louco, mas, uma pergunta:

Onde estão todos esses arquivos que vc vai alterar? Estarão todos numa mesma pasta?

Se não estiverem, como saber onde eles estarão?

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 14/02/2014 2:52 pm
(@cmalves)
Posts: 16
Active Member
Topic starter
 

Estão todos na pasta "C:UsersPJCDesktopClovis"

 
Postado : 14/02/2014 2:55 pm
(@gtsalikis)
Posts: 2373
Noble Member
 

Mesmo não sendo minha praia, veja se ajuda:

Sub Teste_GT()
    
Dim MyObj As Object, MySource As Object, file As Variant
Set MySource = MyObj.GetFolder("C:UsersPJCDesktopClovis")
    
For Each file In MySource.Files
    file.Open
    Windows(file.Name).Activate
        
        
    'coloque seu código aqui. para referenciar o arquivo recém aberto:
        ' tente usar: ActiveDocument
        ' se não der certo, tente usar documents.file.name
        ' se não der certo, tente usar Windows(file.name)
      
      
Next file

End Sub

Lembre-se de AGRADECER aos que te ajudaram, e de marcar o tópico como [Resolvido]
Gente que cuida de gente.

Gilmar

 
Postado : 14/02/2014 3:23 pm
(@cmalves)
Posts: 16
Active Member
Topic starter
 

Desculpe, como não sei programar VBA, não consegui aplicar sua macro porque a minha tem 04 Macros. Sendo que a três primeiras fazem a troca do cabeçalho e rodapés a a 4ª macro executa as três protegendo-as, fechando-as e salvando-as. Se possível me informe seu código completo só para eu alterar a pasta e os textos.
Obrigado por enquanto.
Clovis

 
Postado : 14/02/2014 3:46 pm