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

Respuesta
1

Puedes poner la macro y describir cuales serian las condiciones.

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 Sub

Saludos.Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas