Hola, soy Andrea y este año he aprendido un poco de vba, he avanzado bastante sin embargo hoy me encuentro algo detenida por un error que me genera la macros que he hecho.. he indagado en varios sitios y no he encontrado solución al error, he implementado 2 formas y no he conseguido nada.

La macro se trata de reemplazar datos que están definidos en otra hoja y se reemplazan en un plantilla word, hasta ahí todo bien.. pero es necesario que sea lo mas automatizado posible por ende intento que se guarde en una carpeta especifica, y bueno se guardan pero al intentar abrir el archivo da error, se pega el notebook, todo deja de funcionar.. aveces me da el  error 5174 ( Archivo no encontrado o borrado) cosa que no es así.. de verdad me es muy importante encontrar solución para guardar los archivos y luego poder abrirlos, ya que luego de crearlos se linkean con otros archivos word y hacen un archivo final.  Pero no puedo terminar el producto final por  así  decirlo ya que al ejecutar desde excel se bloquean y dan errores. 

 

La macro que he usado es esta:

 

Sub AWord()

On Error Resume Next

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim Titulo As String
Dim ruta As String
Dim nombre As String

ruta = ThisWorkbook.Path

'Ubicacion y nombre de la plantilla

'La ubicación está dada por la concatenación de los datos de dos celdas + la extensión del archivo de plantillas de Word.
wArch = Sheets("Rutas").Range("C5").Text

direc = Sheets("Rutas").Range("C3").Text

nombre = " OPP-" & Hoja1.Range(" C11 ") & " " & Hoja1.Range(" C7 ")
'Con la variable siguiente definimos que vamos a trabajar con un documento de Word.

Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'Creamos un documento nuevo con la plantilla

objWord.Documents.Add Template:=wArch, NewTemplate:=False, DocumentType:=0

'Utilizamos For para recorrer todas las variables de 1 al dato de la celda C1.
For i = 1 To Hoja3.Range("C1").Value 'celda dónde está la cuenta
datos = Hoja3.Range("B" & i).Text 'dónde están los datos
reemp = Hoja3.Range("A" & i).Text 'dónde están las etiquetas

     'utilizamos buscar y reemplazar de word
     With objWord.Selection.Find
            .Text = datos 'busca el texto de datos
            .Replacement.Text = reemp 'reemplaza por el texto
            .Execute Replace:=2 'la variable en dos es para reemplazar todos los valores
     End With

Next i
 objWord.Activate 'Activa el documento de word
 

    ChangeFileOpenDirectory direc
    'Donde se guardara el archivo word   
    
    ActiveDocument.SaveAs2 Filename:=nombre & ".docx", FileFormat:= _
        wdFormatXMLDocumentMacroEnabled, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

  

Hola

Es una mala costumbre el uso de On Error Resume Next a menos que sea estrictamente necesario, y en tu caso no lo es. Borra dicha línea. Después de borrarla notarás algunos errores que debes corregir. Te adelanto que esta línea, tal cual la tienes, no está haciendo nada:

ChangeFileOpenDirectory direc

Esto de aquí:

FileFormat:= _
        wdFormatXMLDocumentMacroEnabled

Cámbialo por esto:

FileFormat:= _
        wdFormatDocumentDefault

Ojo, no he revisado el detalle de tus variables con las que intentas crear la ruta, pero dado lo que comentas, asumo que son correctas.

Ah ¿Por qué colocas esto?

CompatibilityMode:=15

Comentas.

Hola gracias por responder! 

Mira realice los cambios sugeridos y la macro funciona  al 100% en la segunda compilación... te explico, cuando ejecuto la macro me expulsa el archivo w ord pero sin nombre y no lo guarda donde necesito y en el excel sale error 462

 

 

Luego vuelvo a ejecutar la macro y funciona, me guarda el archivo word con el nombre establecido y donde yo indique. Sin embargo, cuando modifico cualquier casilla  de la  hoja inicio que altere en algo el archivo word y vuelvo a ejecutar nuevamente da error, debo cancelar la macro vuelvo a ejecutar y funciona nuevamente como debiese .

 

 

Disculpa que te pregunte por esto, pero he estado aprendiendo VBA por mi cuenta este año y aun me falta mucho por aprender.. si me pudieras ayudar con este nuevo error lo agradecería,  en resumen: ejecuta la macro modificada y expulsa el archivo sin nombre y sin guardar y al mismo tiempo da el error 462

Error 462  en tiempo de ejecución:
El equipo servidor remoto no existe o no está disponible

Finalizo la macro y ejecuto nuevamente, pero esta vez si guarda y coloca el nombre correspondiente. Si cambio cualquier casillla de la hoja inicio vuelve a dar error al expulsar el word y a las 2da vez funciona. 

 

Te agradecería mucho tu ayuda!!!

Esta es la nueva macro que utilice:

 

Sub AWord()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim Titulo As String
Dim ruta As String
Dim nombre As String

Call EliminarOferta

ruta = ThisWorkbook.Path

'Ubicacion y nombre de la plantilla
'La ubicación está dada por la concatenación de los datos de dos celdas + la extensión del archivo de plantillas de Word.
wArch = Sheets("Rutas").Range("C5").Text

direc = Sheets("Rutas").Range("C3").Text

nombre = " OPP-" & Hoja1.Range(" C11 ") & " " & Hoja1.Range(" C7 ")
'Con la variable siguiente definimos que vamos a trabajar con un documento de Word.

Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'Creamos un documento nuevo con la plantilla

objWord.Documents.Add Template:=wArch, NewTemplate:=False, DocumentType:=0

'Utilizamos For para recorrer todas las variables de 1 al dato de la celda C1.
For i = 1 To Hoja3.Range("C1").Value 'celda dónde está la cuenta
datos = Hoja3.Range("B" & i).Text 'dónde están los datos
reemp = Hoja3.Range("A" & i).Text 'dónde están las etiquetas

     'utilizamos buscar y reemplazar de word
     With objWord.Selection.Find
            .Text = datos 'busca el texto de datos
            .Replacement.Text = reemp 'reemplaza por el texto
            .Execute Replace:=2 'la variable en dos es para reemplazar todos los valores
     End With

Next i
 objWord.Activate 'Activa el documento de word
    

    ActiveDocument.SaveAs2 Filename:=direc & "\" & nombre & ".docx", _
    FileFormat:=wdFormatDocumentDefault
      
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
 

 

Hola nuevamente:

Como comenté, no revisé todo, pero hay otro error, reemplaza:

objword.ActiveDocument.SaveAs2 Filename:=direc & "\" & nombre & ".docx", _
    FileFormat:=wdFormatDocumentDefault

Saludos

Hola, funciona la macro con esas ultimas ediciones que me recomendaste y  lo coloque en la macro de tablas que tengo y me  expulsa  los archivos word con las tablas, pero me da error, esta es la macro de las tablas: 

Cita

 

Sub TablaConfig2()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets("ConfigX (1)").Select

If ActiveSheet.Name = "ConfigX (1)" Then

Dim WordApp As Object
Dim ruta, nombre, direc As String
Dim b, mc As String

Set WordApp = CreateObject("Word.Application")

ruta = ThisWorkbook.Sheets("Rutas").Range("C6").Text
direc = ThisWorkbook.Sheets("Rutas").Range("C6").Text
nombre = "ConfigX (1)"

b = Sheets("ConfigX (1)").Select

mc = Sheets("ConfigX (1)").UsedRange.Address(False, False)
Range(mc).Select

   Debug.Print mc

'Formatos 

Sheets("ConfigX (1)").Select

    Columns("A:A").ColumnWidth = 10
    Columns("B:B").ColumnWidth = 28
    Columns("C:C").ColumnWidth = 4
    Columns("D:D").ColumnWidth = 30
    
    
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    
    Range(mc).Select
    
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    
  With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

'Formatos 

   
Sheets("ConfigX (1)").Range(mc).Copy

With WordApp
'Con este codigo se abrira Word y se creara un documento nuevo
.Visible = True
.Activate
.Documents.Add
End With

 
WordApp.Selection.PasteSpecial Link:=True
 

  
   WordApp.ActiveDocument.SaveAs2 Filename:=direc & "\" & nombre & ".docx", FileFormat:=wdFormatDocumentDefault
 

Else
End If
 

 End Sub 

 

Cuando intento colocar  en la linea

.Visible = False

me da este error

Y ademas cuando abro el archivo cuando lo vuelvo a colocar la linea

.Visible = True

 Todos los archivos quedan automáticamente en MODO LECTURA y no me deja abrirlos, la idea es que no queden protegidos para abrirse con facilidad y editar si es necesario, a estos archivos expulsados por el excel NO se le puede quitar la protección... 

 

Es 2da vez que me sucede esto y no se porque se guardan de ese modo! Por favor ayuda! Se los agradezco mucho!

¿Estas segura que en esa línea ocurre el error? ¿Estás segura que es con esa macro que has mostrado?