Pessoal, criei um formulário no Excel e estou com dificuldade de completar um dos módulos integrados com o Word. Gostaria que alguém me ajudasse a completar os códigos faltantes na rotina abaixo.
No documento gerado é necessário localizar algumas partes do texto e, caso localizadas, selecioná-las e substituí-las por "inserir texto do arquivo". Porém, não estou conseguindo definir o código aplicável para condicionar que somente sejam substituídos e inseridos os textos dos arquivos cujos textos forem efetivamente localizados e, caso não existentes no documento, seguir com a rotina para a parte seguinte que precisa ser substituída.
A rotina é a seguinte:
'abrir o documento - localizar e selecionar cada um dos textos que serão substituídos - se não localizado, ir para o próximo - se localizado, selecionar e substituir por "inserir texto do arquivo" - ir para o próximo aplicando a rotina até o último - salvar o documento para revisão - finalizar a rotina.
Grato pelo retorno.
Sub GERAR_MINUTA()
'
' GERAR_MINUTA Macro
' GERAR DOCUMENTO PARA REVISÃO TEXTO
'
Dim WORD As WORD.Application
Dim DOC As WORD.Document
WORD.Visible = True
Set DOC = WORD.Documents.Open("C:UsersDocumentsDOCUMENTO-1.docx")
With DOC
.Application.Selection.Find.Text = "TEXTO1 TEXTO1 TEXTO1"
.Application.Selection.Find.Execute
.Application.Selection.InsertFile FileName:= "C:DOCUMENTOSTEXTO1 PARA INSERIR.docx" , Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
.Application.Selection.Find.Text = "TEXTO2 TEXTO2 TEXTO2"
.Application.Selection.Find.Execute
.Application.Selection.InsertFile FileName:= "C:DOCUMENTOSTEXTO2 PARA INSERIR.docx" , Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
.Application.Selection.Find.Text = "TEXTO3 TEXTO3 TEXTO3"
.Application.Selection.Find.Execute
.Application.Selection.InsertFile FileName:= "C:DOCUMENTOSTEXTO3 PARA INSERIR.docx" , Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
With DOC
.SaveAs2 ("C:UsersDocumentsDOCUMENTO-1.docx")
End With
Set DOC = Nothing
Set WORD = Nothing
End With
End Sub
Postado : 19/09/2017 3:23 pm