Ejecutar Macros antes y después de guardar a PDF

Para Dante Amor,

¿Dante cómo estas? Necesito si me podes ayudar con un problema que me surgió últimamente. Como puedo hacer para que antes de guardar y enviar por mail se ejecute una macro que me filtra las celdas solo con ventas de las hojas activas y que al finalizar me ejecute otra para dejar todo en cero. Yo tengo una macro por cada hoja. Para filtrar y para borrar. Tengo la celda M4 que si es diferente a Cero que ejecute las dos macros. Espero que me puedas ayudar!

Te adjunto la macro que uso para guardar y enviar por mail.

Sub GuardarPDF_2()

'Por.Dante Amor
    Dim hojas()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = "C:\Ventas\Facturación 2016\"
    'ruta = "C:\trabajo\"
    n = -1
    Set h1 = Sheets("Hoja1")        'Primera hoja donde vas a poner el cliente
    '
    cliente = h1.Range("G4")
    If cliente = "" Then
        MsgBox "Debes capturar el cliente en la primera hoja", vbCritical
        Exit Sub
    End If
    '
    For Each h In Sheets
        h.[G4] = cliente
        If h.[L4] <> 0 Then
            n = n + 1
            ReDim Preserve hojas(n)
            hojas(n) = h.Name
            If nomb = "" Then
                nomb = h.[G4] & " " & Format(h.Range("G2"), "dd-mm-yyyy") + Format(Now, "(hh'mm)") & ".pdf"
            End If
        End If
    Next
    '
    If n > -1 Then
        usuario = Environ$("computername")
        Set h = Sheets("usuarios")
        Set b = h.Columns("A").Find(usuario)
        If b Is Nothing Then
            MsgBox "El usuario: " & usuario & " no existe en la hoja 'usuarios'", vbCritical
            Exit Sub
        End If
        '
        correos = b.Offset(0, 1)
        Sheets(hojas).Copy
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & nomb, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.Close False
        '
        Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = correos
        dam.Subject = nomb
        dam.Body = "Orden de Pedido"
        dam.Attachments.Add ruta & nomb
        dam.Display 'El correo se envía en automático
        'dam.Display 'El correo se muestra
        '
        MsgBox "Orden lista para enviar, favor revisar correo"
    End If
End Sub

1 Respuesta

Respuesta
1

Puedes poner tu macro que filtra y borra.

Según la macro

If h.[L4] <> 0 Then

Si la celda L4 es diferente de 0 la hoja se envía. ¿Ahora también tiene que verificar la celda M4?

Gracias, por tu respuesta!!

Mi macro para filtrar.

Donde debería agregar la que me pasaste?

Sub VistaPrevia()
'
' VistaPrevia Macro
'

'
    ActiveSheet.Unprotect
    Columns("N:O").Select
    Selection.EntireColumn.Hidden = True
    Range("J7").Select
    Selection.AutoFilter
    ActiveSheet.Range("$B$7:$P$201").AutoFilter Field:=9, Criteria1:=">=1", _
        Operator:=xlAnd, Criteria2:="<=10000000"
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End Sub

Así quedaría el código completo

Sub GuardarPDF_2()
'Por.Dante Amor
    Dim hojas()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = "C:\Ventas\Facturación 2016\"
    'ruta = "C:\trabajo\"
    n = -1
    Set h1 = Sheets("Hoja1")        'Primera hoja donde vas a poner el cliente
    '
    cliente = h1.Range("G4")
    If cliente = "" Then
        MsgBox "Debes capturar el cliente en la primera hoja", vbCritical
        Exit Sub
    End If
    '
    For Each h In Sheets
        h.Select
        ActiveSheet.Unprotect
        h.[G4] = cliente
        If h.[L4] <> 0 Then
            h.Select
            Call VistaPrevia
            n = n + 1
            ReDim Preserve hojas(n)
            hojas(n) = h.Name
            If nomb = "" Then
                nomb = h.[G4] & " " & Format(h.Range("G2"), "dd-mm-yyyy") + Format(Now, "(hh'mm)") & ".pdf"
            End If
        End If
    Next
    '
    If n > -1 Then
        usuario = Environ$("computername")
        Set h = Sheets("usuarios")
        Set b = h.Columns("A").Find(usuario)
        If b Is Nothing Then
            MsgBox "El usuario: " & usuario & " no existe en la hoja 'usuarios'", vbCritical
            Exit Sub
        End If
        '
        correos = b.Offset(0, 1)
        Sheets(hojas).Copy
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & nomb, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.Close False
        '
        Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = correos
        dam.Subject = nomb
        dam.Body = "Orden de Pedido"
        dam.Attachments.Add ruta & nomb
        dam.Display 'El correo se envía en automático
        'dam.Display 'El correo se muestra
        '
        MsgBox "Orden lista para enviar, favor revisar correo"
    End If
End Sub
'
Sub VistaPrevia()
'
' VistaPrevia Macro
'
'
    ActiveSheet.Unprotect
    Columns("N:O").Select
    Selection.EntireColumn.Hidden = True
    Range("J7").Select
    Selection.AutoFilter
    ActiveSheet.Range("$B$7:$P$201").AutoFilter Field:=9, Criteria1:=">=1", _
        Operator:=xlAnd, Criteria2:="<=10000000"
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Sabes que me da error acá.

Sub indicie fuera del intervalo

Set h1 = Sheets("Hoja1")        'Primera hoja donde vas a poner el cliente

Me había comido un paso anterior el error me lo da en esta línea

 For Each h In Sheets
        h.Select
        ActiveSheet.Unprotect

Solamente copié la macro como la pusiste.

Cambia "Hoja1" por el nombre de la hoja donde vas a poner el cliente.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Porque solo me aplica el filtro a la hoja activa? y no a todas que tiene la condición que si L4 es diferente de 0 que aplique el filtro vista previa?

El filtro se aplica solamente a las hojas donde L4 es diferente de 0. Revisa que las hojas efectivamente en L4 tengan diferente de 0.

Le hice unos ajustes a tu macro. Tienes que copiar las 2 macros completas.

Sub GuardarPDF_2()
'Por.Dante Amor
    Dim hojas()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'ruta = "C:\Ventas\Facturación 2016\"
    ruta = "C:\trabajo\"
    n = -1
    Set h1 = Sheets("Hoja1")        'Primera hoja donde vas a poner el cliente
    '
    cliente = h1.Range("G4")
    If cliente = "" Then
        MsgBox "Debes capturar el cliente en la primera hoja", vbCritical
        Exit Sub
    End If
    '
    For Each h In Sheets
        h.Select
        ActiveSheet.Unprotect
        h.[G4] = cliente
        If h.[L4] <> 0 Then
            h.Select
            Call VistaPrevia
            n = n + 1
            ReDim Preserve hojas(n)
            hojas(n) = h.Name
            If nomb = "" Then
                nomb = h.[G4] & " " & Format(h.Range("G2"), "dd-mm-yyyy") + Format(Now, "(hh'mm)") & ".pdf"
            End If
        End If
    Next
    '
    If n > -1 Then
        usuario = Environ$("computername")
        Set h = Sheets("usuarios")
        Set b = h.Columns("A").Find(usuario)
        If b Is Nothing Then
            MsgBox "El usuario: " & usuario & " no existe en la hoja 'usuarios'", vbCritical
            Exit Sub
        End If
        '
        correos = b.Offset(0, 1)
        Sheets(hojas).Copy
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & nomb, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.Close False
        '
        Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = correos
        dam.Subject = nomb
        dam.Body = "Orden de Pedido"
        dam.Attachments.Add ruta & nomb
        dam.Display 'El correo se envía en automático
        'dam.Display 'El correo se muestra
        '
        MsgBox "Orden lista para enviar, favor revisar correo"
    End If
End Sub
'
Sub VistaPrevia()
'
' VistaPrevia Macro
'
'
    ActiveSheet.Unprotect
    Columns("N:O").Select
    Selection.EntireColumn.Hidden = True
    'Range("J7").Select
    'Selection.AutoFilter
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    ActiveSheet.Range("$B$7:$P$201").AutoFilter Field:=9, Criteria1:=">=1", _
        Operator:=xlAnd, Criteria2:="<=10000000"
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Dante, 

Sabes que me da un error en esta parte del código.

 For Each h In Sheets
        h.Select
        ActiveSheet.Unprotect

Gracias por tu ayuda!!

¿Qué error te aparece?

¿Tienes las hojas ocultas?

¿Tienes el libro protegido?

Puedes desproteger las hojas, el libro, mostrar las hojas y probar la macro.

Si la macro te funciona, recuerda valorar la respuesta.

Dante, el problema es que me guarda en todas las hojas el nombre de cliente en la G4

yo solo quiero que me copie el cliente de las hojas activas? 

Muchas gracias!!

¿Y a qué le llamas hoja activa?

¿Significa qué tienes otras que están ocultas?

¿Quieres qué solamente lo haga en las hojas visibles?

Sub GuardarPDF_2()
'Por.Dante Amor
    Dim hojas()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'ruta = "C:\Ventas\Facturación 2016\"
    ruta = "C:\trabajo\"
    n = -1
    Set h1 = Sheets("Hoja1")        'Primera hoja donde vas a poner el cliente
    '
    cliente = h1.Range("G4")
    If cliente = "" Then
        MsgBox "Debes capturar el cliente en la primera hoja", vbCritical
        Exit Sub
    End If
    '
    For Each h In Sheets
        If h.Visible = -1 Then
            h.Select
            ActiveSheet.Unprotect
            h.[G4] = cliente
            If h.[L4] <> 0 Then
                h.Select
                Call VistaPrevia
                n = n + 1
                ReDim Preserve hojas(n)
                hojas(n) = h.Name
                If nomb = "" Then
                    nomb = h.[G4] & " " & Format(h.Range("G2"), "dd-mm-yyyy") + Format(Now, "(hh'mm)") & ".pdf"
                End If
            End If
     End If
    Next
    '
    If n > -1 Then
        usuario = Environ$("computername")
        Set h = Sheets("usuarios")
        Set b = h.Columns("A").Find(usuario)
        If b Is Nothing Then
            MsgBox "El usuario: " & usuario & " no existe en la hoja 'usuarios'", vbCritical
            Exit Sub
        End If
        '
        correos = b.Offset(0, 1)
        Sheets(hojas).Copy
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & nomb, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.Close False
        '
        Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = correos
        dam.Subject = nomb
        dam.Body = "Orden de Pedido"
        dam.Attachments.Add ruta & nomb
        dam.Display 'El correo se envía en automático
        'dam.Display 'El correo se muestra
        '
        MsgBox "Orden lista para enviar, favor revisar correo"
    End If
End Sub
'
Sub VistaPrevia()
'
' VistaPrevia Macro
'
'
    ActiveSheet.Unprotect
    Columns("N:O").Select
    Selection.EntireColumn.Hidden = True
    'Range("J7").Select
    'Selection.AutoFilter
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    ActiveSheet.Range("$B$7:$P$201").AutoFilter Field:=9, Criteria1:=">=1", _
        Operator:=xlAnd, Criteria2:="<=10000000"
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas