Ejecutar Documento Word en Primer plano

Alex_edm · el 20 de noviembre

Hola:

Tengo una macro de excel que a partir de una plantilla de word, genera un nuevo archivo de Word y lo guarda en una ubicación especifica. El tema es que al final de todo esto necesito que ese documento de word generado se muestre en primer plano pero no lo consigo, aparece siempre detras del resto de programas o minimizado. He probado lo siguiente sin exito:

Static objword As Object

.

.

    wdDoc.SaveAs Filename:=rutainf, FileFormat:=wdFormatXMLDocument
    wdDoc.Activate
    wdDoc , vbMaximmizedFocus

Muchas gracias. Saludos.

Abraham Valencia · el 20 de noviembre

Hola

Intenta con:

Application.ActivateMicrosoftApp xlMicrosoftWord

Alex_edm · el 21 de noviembre

Hola Abraham:

Muchas gracias por tu respuesta, he probado pero lo que consigo es que me abra un nuevo archivo de de word en blanco. Lo he colocado en varios sitios y nada...

¿Alguna idea mas?

Un saludo.

Abraham Valencia · el 21 de noviembre

Tengo la impresión o de que no te entendemos del todo o que hay "algo" que no estás comentando/mostrando. Adjunta el archivo. Si es muy grande, colócalo en algún Drive y envía el enlace. No olvides comentar cómo activar lo del dilema.

Alex_edm · el 21 de noviembre

Hola:

El excel como tal no puedo adjuntarlo, tendría que adaptarlo mucho porque tiene mucha información confidencial. Pongo el código del Módulo a ver si con eso vale, si no es suficiente adapto el archivo y lo subo; adjunto el módulo tambien. Muchas gracias:

    'Variables publicas que se pueden usar en todo el Excel
    Public K As Integer
    Public pctCompl As Single

Sub ExcelModificaPlantillaWord(Abierto As Single)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'Dim objWord As Word.Application, wdDoc As Word.Document
    Static datos(0 To 1, 0 To 7) As String
    On Error Resume Next
    Set a = Sheets(ActiveSheet.Name)                        'Creamos un objeto con la hoja de excel
    Static ruta_save As String
    Static rutainf As String
    Static Directorio As FileDialog
    Static objword As Object
    Static wdDoc As Object
    Set aDoc = ActiveDocument
    
    If Abierto = 1 Then
        GoTo FormularioAbierto  'Se salta parte del codigo despues de volver del formulario
    End If
    
    'InputBox para introducir el número de máquina / proyecto
    num_maq = InputBox("      INTRODUCIR EL NÚMERO DE" & vbNewLine & "           MÁQUINA / PROYECTO", "Nº MÁQUINA")
    
    'Copia el nombre del archivo en una celda, que a su vez se utiliza para generar placas de características
    ActiveSheet.Range("L21").Value = num_maq
    
    nom = ActiveWorkbook.Name                               'Determinamos el nombre del archivo
    pto = InStr(nom, ".")
    nomarch = Left(nom, pto - 1)
    'ruta = ThisWorkbook.Path & "\" & nomarch & ".docx"                 'Ruta de donde se va a abrir el archivo Word
    ruta_plantilla = ThisWorkbook.Path & "\" & nomarch & ".docx"        'Ruta de donde se va a abrir el archivo Word
    Set objword = CreateObject("Word.Application")
    objword.DisplayAlerts = wdAlertsNone
    objword.Visible = True
    
    'Selección de directorio donde se va a guardar el archivo word de salida
    Set Directorio = Application.FileDialog(msoFileDialogFolderPicker)
    With Directorio
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        .Title = "Selecciona la Carpeta para Guardar las PLACAS DE CARACTERÍSTICAS"
        If .Show = 0 Then Exit Sub
        ruta_save = .SelectedItems(1)
    End With
    
    ruta = ruta_save & "\" & nomarch & ".docx"
    
    Set wdDoc = objword.Documents.Open(ruta_plantilla)                                            'Se crea un objeto con la ruta del archivo
    nomfic = a.Range("L21") & "_" & a.Range("I7") & "_" & "PLACAS DE CARACTERÍSTICAS"   'Se determina el nombre con el que vamos a guardar el archivo
    'rutainf = ThisWorkbook.Path & "\" & nomfic & ".docx"
    rutainf = ruta_save & "\" & nomfic & ".docx"
    
    
    'Creamos un bucle que va desde el primero al último número de la matriz
    UserForm1.Show  'Abre el formulario

FormularioAbierto:  ' Arranca desde aqui al volver del formulario

    'pctCompl = 0    ' Incializa el valor de pctComp1
    
     'Asignamos a variables que se debe buscar y el texto por que se debe reemplazar
    datos(0, 0) = "[MODEL]"
    datos(1, 0) = a.Range("I7")
    datos(0, 1) = "[SERIAL]"
    datos(1, 1) = a.Range("L21")
    datos(0, 2) = "[YEAR]"
    datos(1, 2) = Year(a.Range("L22"))      'Estrae el año de la fecha
    datos(0, 3) = "[VOLTAGE]"
    datos(1, 3) = a.Range("I22")
    datos(0, 4) = "[FREQ]"
    datos(1, 4) = a.Range("I15")
    datos(0, 5) = "[CURRENT]"
    datos(1, 5) = Round(a.Range("I18"), 1)  'Redondea un decimal
    datos(0, 6) = "[POWER]"
    datos(1, 6) = Round(a.Range("I17"), 1)  'Redondea un decimal

    K = UBound(datos, 2)    'Mete el maximo de variables totales a modificar dentro de la variable publica K para el Formulario
    
    wdDoc.Unprotect         'Desbloquea el word para poder escribir en el
    
    For i = 0 To UBound(datos, 2)
    
    textobuscar = datos(0, i)
    objword.Selection.Move 6, -1
    objword.Selection.Find.Execute FindText:=textobuscar
    'Bucle para reemplazar todo el texto que encuentre y solo el primero que encuentre
    While objword.Selection.Find.Found = True
    objword.Selection.Text = datos(1, i) 'texto a reemplazar
    objword.Selection.Move 6, -1
    objword.Selection.Find.Execute FindText:=textobuscar
    Wend
    pctCompl = i    'Mete el valor de I dentro de la variable pctComl para enviarla a la barra de progreso
    Call Aumenta_progreso(pctCompl) 'Llama al procedimiento que actualiza la barra de progreso
    Next i
    
    'wdDoc.Protect (wdAllowOnlyFormFields)   'Bloquea el archivo word para que solo permitar editar los campor de formulario **NO FUNCIONA
        
    UserForm1.Hide  'Cierra el formulario
    'Guarda el archivo con el nombre asignado
    wdDoc.SaveAs Filename:=rutainf, FileFormat:=wdFormatXMLDocument
    'wdDoc.Close
    MsgBox ("PLACAS DE IDENTIFICACIÓN DE MÁQUINA GENERADAS CON EXITO"), vbInformation, "AVISO"
    wdDoc.Activate
    wdDoc.Protect (wdAllowOnlyFormFields)   'Bloquea el archivo word para que solo permitar editar los campor de formulario **NO FUNCIONA
    wdDoc , vbMaximmizedFocus
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    

    
    Shell "explorer " & ruta_save, vbNormalFocus    'Abre el explorar donde se ha guardodo el archivo word
    
    End
End Sub

Sub Aumenta_progreso(pctCompl As Single)
Dim F As Single 'En cuanto tiene que incrementar el porcentaje para llegar a 100 segun la variable K (Numero de varibles a remplazar)
Dim W As Single 'Porcentaje completado
Dim P As Single 'En cuanto tiene que incrementar la barra para llegar a 100 segun la variable K (Numero de varibles a remplazar)
F = 100 / K
W = F * pctCompl
P = 204 / K     '204 es el ancho total de la barra de progreso
'Actualizo el UserForm
UserForm1.Progreso.Caption = Fix(W) & "% Completado"
UserForm1.Barra.Width = pctCompl * P

'Me permite actualizar el Userform y que se refleje
DoEvents
End Sub

Un saludo.

Módulo2.bas

Abraham Valencia · el 21 de noviembre

Hola

Tienes cosas innecesarias, pero bueno, ese ya es otro tema.

No me queda claro eso de que abres la carpeta pero a su vez quiere el ¿último archivo? activo, así que, después de esta línea:

Shell "explorer " & ruta_save, vbNormalFocus

Coloca esto:

 AppActivate (nomfic & ".docx")

Prueba ya que yo lo estoy haciendo de memoria pues evidentemente al no tener tus archivo (así, en plural), no puedo probar.

PD: Es una mala costumbre usar On Error Resume Next, deberías borrarlo

Alex_edm · el 22 de noviembre

Hola:

En primer lugar, gracias por responder. Si, quiero abrir la carpeta donde se ha guardado el archivo Word y por otra parte abrir el archivo Word. He probado a colocar AppActivate... tal y como me dices pero sigue sin funcionar. Como alternativa se me ha ocurrido minimizar el propio excel con Application.WindowState = xlMinimized y entonces el word queda en primer plano.

Respecto a lo que me dices de On Resume Next, lo he colocado porque lo he leido por ahi. Podrías indicarmecomo me podría afectar negativamente (te hablo desde mi total desconocimiento).

Muchas gracias. Un saludo.

Abraham Valencia · el 22 de noviembre

On Error Resume Next lo que hace es "saltar" cualquier erro, es decir, tu macro podría tener errores y tú ni cuenta hasta que en algún momento empiece a fallar y no sabrás qué ocurre hasta que borres esa línea. Por ejemplo, eso de que ninguna instrucción recomendada hacía lo que solicitabas, podría estar ocurriendo por algún problema o error de alguna línea previa y no se puede saber por la línea en cuestión. Esa línea solo se debe usar cuando es estrictamente necesario y se sabe que no ocasionará problemas a futuro. Por último, un buen programador, una buena macro, siempre controlará los errores probables de otros modos.