Macro con Excel busca en Word y coloca en negrita
Tengo una macro que habré un word y busca el texto y remplaza por otro pero además de que lo busca y remplaza quiero que lo ponga en negritas
Este código lo metería en una condicional ya que ciertos textos quiero que sean de negritas
1 Respuesta
si claro la macro es la siguiente
hu = ActiveWorkbook.Path 'tomo la direccion del archivo de excel que estoy trabajando
'en este creo el objeto del word y habro un archivo que tengo como plantilla
Set objw = CreateObject("Word.Application")
With objw
.Documents.Open hu & "\Word cartas.docx"
.Visible = True
End With
'tomo los valores de una celda que esta en la hoja carta
bus = Worksheets("carta").Range("a2").Value
dat = Worksheets("carta").Range("c1").Value
genero el rango del archivo de word y realizo la busqueda y remplazo el texto
Set myRange = objw.ActiveDocument.Content
With myRange.Find
.ClearFormatting
.Text = bus
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
myRange.Text = dat
Loop
End With
' en este intento que busque el texto ya remmplazado y lo ponga en negritas pero no me sale error y no lo realiza
Set myRange = objw.ActiveDocument.Content
With myRange.Find
.text=dat
Font.Bold = True
end with
espero que me puedas ayudar
Te regreso la nueva macro
Sub cambiar()
'Act.Por.Dante Amor
Set objWord = CreateObject("Word.Application") 'Creo objeto de Word
hu = ActiveWorkbook.Path 'Ruta del archivo
With objWord
.Documents.Open hu & "\Word cartas.docx"
.Visible = True
End With
bus = Worksheets("carta").Range("a2").Value 'Dato
dat = Worksheets("carta").Range("c1").Value 'Nuevo
'
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=bus 'Busca el dato
While objWord.Selection.Find.found = True
objWord.Selection.Text = dat 'Se pone el Nuevo
objWord.Selection.Font.Bold = True 'Pone negritas
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=bus 'Busca otro dato
Wend
Set objWord = Nothing
End SubSaludos.Dante Amor
