Modificar macro que imprima y guarde archivo

El arreglo del código, desde el mensaje hasta el cierre quedaría así:

'em: si se presenta mensaje pasa a la línea de cierre y allí se permite guardar con otro nombre
    On Error Resume Next
    If [N6] = "minerd" Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA MINERD-22-23\"
    ElseIf [N6] = "privado" Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA PRIVADO-22-23\"
    Else
        ruta = "\\Cl-srv-01\Recursos\SHADAY\CARPETA DE FACTURA\"
    End If
    ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
    ActiveWorkbook. Close True

Ahora, si la celda N6 tiene un texto que contiene alguna de estas palabras (por ej: Colegio privado) entonces la comparación debiera ser de este modo:

    If InStr(1, [N6], "minerd") > 0 Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA MINERD-22-23\"
    ElseIf InStr(1, [N6], "privado") > 0 Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA PRIVADO-22-23\"
    Else
        ruta = "\\Cl-srv-01\Recursos\SHADAY\CARPETA DE FACTURA\"
    End If

Sdos. No olvides marcar una valoración si la respuesta resuelve tu consulta.

Elsa

*Te invito a visitar la sección Manuales de mi sitio... acabo de publicar el Manual 500Macros+365 (revisión y actualización completa del manual 500Macros incluyendo código apto para la versión Excel 365 + nuevos capítulos). Imperdible!

Me esta presentando la ventana para forzar el guardado.

Se supone que la macro debe ir a la celda (N6) y buscar una de las dos palabras ¨¨minerd¨´, ´´privado´´ y luego guardar el libro con el nombre que encuentre en la celda (N9) en la carpeta que le corresponda el nombre que alla encontrado en (N6).

Perdon, no es (N9), es (A9)

cuando ejecuto la macro me señala esta linea:

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

En la parte del código que ajusté para evaluar el contenido de una celda, debes cambiar [N6] por la celda que tenga el texto 'minerd' o 'privado'.  Entiendo que sería [A9].

Con respecto al otro mensaje de error, no sabría decirte el motivo. No es parte del código que tenga que ver con el guardado, sino con la impresión. Si antes ya funcionaba no hay razón para que no lo haga ahora.

¿Quizás hiciste algunos otros cambios?

Sdos!

La celda que tiene la palabra ¨´minerd´´, ´´privado´´ es (N6) no es (A9).

Actualmente la macro cuando se le da al botón de ´´imprimir´´ toma la información de (A9) para guardar el libro con esos datos en una carpeta especifica.

Lo que se esta pidiendo a la macro ahora es que cuando se presione el botón ´´imprimir´´ guarde en la (carpetade factura minerd) si encuentra en (N6) ´´minerd´´ o (carpeta de factura privado)si encuentra en (N6) ´´privado´´ .

Hice unas modificaciones a lo que me envío y ya no pide que force el guardado pero no esta enviando nada a la carpeta:

'em: si se presenta mensaje pasa a la línea de cierre y allí se permite guardar con otro nombre
    On Error Resume Next
    If [N6] = "minerd" Then
    ActiveWorkbook.SaveAs _
        Filename:="D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA MINERD-22-23\"
    ElseIf [N6] = "privado" Then
    ActiveWorkbook.SaveAs _
        Filename:="D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA PRIVADO-22-23\"
    Else
    ActiveWorkbook.SaveAs _
        Filename:="\\Cl-srv-01\Recursos\SHADAY\CARPETA DE FACTURA\"
    End If
    ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
    ActiveWorkbook.Close True

En las modificaciones que me envio no veo la condicion "SaveAs" lo cual entiendo se necesita en la macro para guardar en una de las dos carpetas nombradas.

por favor corrijame si estoy errado.

Saludos,

MG

No se supone que estas deberían ser las líneas para que guarde en las carpetas que deseo>

ActiveWorkbook.SaveAs _
        Filename:="D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA MINERD-22-23\" & num & ".xls", _
        FileFormat:=xlNormal

Que pena con este foro, no estaban enviando los mensajes.

En mi macro solo defino la 'ruta' ..., la variable 'num' ya la tenías en líneas más arriba, por lo que luego sí aparece la instrucción SAVEAS:

'em: si se presenta mensaje pasa a la línea de cierre y allí se permite guardar con otro nombre
    On Error Resume Next
    If [N6] = "minerd" Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA MINERD-22-23\"
    ElseIf [N6] = "privado" Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA PRIVADO-22-23\"
    Else
        ruta = "\\Cl-srv-01\Recursos\SHADAY\CARPETA DE FACTURA\"
    End If
    ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
    ActiveWorkbook. Close True

Me parece que estás haciendo mal las correcciones. Quedate con tu macro original y solo cambiá la parte desde el comentario: 'em: si ...'

En la instrucción que dice SaveAs la extensión quedó como xls... modificá esto si ahora vas a guardar en xlsm.

Sdos!

La corrí con la nueva macro que me envío en office-7 y se friza por 15 segundo luego termina pero no guarda el archivo en la carpeta deseada. Luego pobre con office-2003 y guarda el archivo en una sola carpeta(Minerd), aunque escribo la palabra (Privado).

Seria posible enviarle el archivo por correo para que haga una prueba

Public boton As Boolean
Sub Imprimir()
'Por.DAM - Corregido por Elsamatilde
If ActiveSheet.Name = "." Then
    Set h1 = ActiveSheet
    'EM: QUITAR PARA QUE MUESTRE MENSAJE DE ARCHIVO EXISTE
    'Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    boton = True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    num = Range("A9")
    ActiveSheet.Copy
    If ActiveSheet.ProtectContents Then
        ActiveSheet.Unprotect "maximo"
    End If
    h1.Range("E9").Copy
    Range("E9").PasteSpecial Paste:=xlValues
    ActiveSheet.Protect "maximo"
    'em: si se presenta mensaje pasa a la línea de cierre y allí se permite guardar con otro nombre
    On Error Resume Next
    If [N6] = "minerd" Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA MINERD-22-23\"
    ElseIf [N6] = "privado" Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA PRIVADO-22-23\"
    Else
        ruta = "\\Cl-srv-01\Recursos\SHADAY\CARPETA DE FACTURA\"
    End If
    ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
    ActiveWorkbook.Close True
    'EM: SI SE CANCELA EL GUARDADO QUEDA COMO LIBRO ACTIVO y hay que forzar el cerrado.
    If Left(ActiveWorkbook.Name, 5) = "Libro" Then
        ActiveWorkbook.Close False
    End If
    ActiveSheet.Unprotect "maximo"
        Range("D5") = Range("D5") + 1
    ActiveSheet.Protect "maximo"
    'Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End If
boton = False
End Sub
Sub printprev()
'Por.dam
boton = True
ActiveWindow.SelectedSheets.PrintPreview
boton = False
End SubPublic boton As Boolean

A ver si nos entendemos:

Tenías una macro que parece que corría bien.

Lo UNICO que ahora le cambiamos, es decirle que guarde en la variable 'ruta' un texto, dependiendo del valor de la celda N6. Más simple que eso no hay,

Por lo tanto, que se friza no tiene nada que ver con ésto.

Y que no se guarde en la otra carpeta, puede darse si encuentra el texto escrito de otro modo, quizás con algún espacio demás.

Mostrame exactamente con una imagen, qué tiene la celda N6.

En mi primer respuesta te dejé 2 opciones: ya sea que encuentre la palabra exacta, o como contenido de un texto mayor. Revisá por favor nuevamente mi primer respuesta.

Si se trata de una sola palabra, podemos forzar a una comparación en mayúsculas y sin espacios adicionales:

If Ucase(Trim([N6])) = "MINERD" Then    

Y lo mismo con privado:   If Ucase(Trim([N6])) = "PRIVADO" Then

Si no lo podés resolver debieras enviarme la hoja o subirla en algún sitio para descargarla y dejar el enlace aquí.

Y no olvides de revisar la extensión, si ahora estás cambiando de versión:

ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal

Sdos!

Anexo envío imagen del archivo mostrando en color rojo las celdas que la macro mira (N6) y (A9). En la macro aparece (A9) que es donde mira cuando guarda el archivo, (N6) lo va utilizar solo para comparar si esta la palabra (minerd o privado).

Entonces reitero mi primera respuesta con el agregado de las mayúsculas (UCASE) y quitando los posibles espacios demás (TRIM).

'em: si se presenta mensaje pasa a la línea de cierre y allí se permite guardar con otro nombre
    On Error Resume Next
    If UCASE(TRIM([N6])) = "MINERD" Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA MINERD-22-23\"
    ElseIf UCASE(TRIM([N6])) = "PRIVADO" Then
        ruta = "D:\COLEGIO CLAREN LEHMAN\CARPETA DE FACTURA PRIVADO-22-23\"
    Else
        ruta = "\\Cl-srv-01\Recursos\SHADAY\CARPETA DE FACTURA\"
    End If
    ActiveWorkbook.SaveAs Filename:=ruta & num & ".xls", FileFormat:=xlNormal
    ActiveWorkbook. Close True

Como puedes ver, solo se está haciendo una comparación y guardando el libro en las rutas que le indicas, con nro y extensión que le indicas. Por lo que debiera correr como antes, salvo la demora normal por el guardado.

Sdos!

Sdos!

Buen dia, ELsa

Ahora si esta enviando el archivo a la carpeta deseada de acuerdo a la palabra que encuentra, pero ahora tengo el inconveniente que la celda (A9) tiene una fórmula que concatena tres celdas y cuando la macro cambia el numero de secuencia que esta en (D5), la fórmula no se actualiza.

¿Sera por estar usando Office?

=CONCATENAR(N4;"-";A7;"-";D5)