Impresión después de aplicar un filtro con macro
@Dante Amor nuevamente te escribo una pregunta para pedir tu apoyo en realidad estoy muy agradecida contigo por tu valiosa ayuda, como te comente en preguntas anteriores tengo inconvenientes con la impresión después de aplicar los check box y me comentaste que hiciera otra pregunta, ya agregue el código que me indicaste, me queda el inconveniente de la impresion que habíamos visto y me comentabas que se te ocurría para apoyarme, te envie nuevamente el archivo a tu correo.
Este texto corresponde a las preguntas anteriores: otra ayuda es que cuando marco los check box ya sea de los 3 marcados y quiero imprimir las hojas de los renglones se distorsionan los cuadros en unas hojas salen 3, en otras 2, en otras 5 y así sucesivamente, en cambio cuando no está filtrado con la casilla de celda k5, y los checkbox marcados
Y en esta imagen cuando no tiene filtrado nada se ve así, y es como lo necesito pero cuando ya esta filtrado se distorsiona
1 Respuesta
Hola Cartagena Lopez,
El problema está cuando hace el filtro, se conservan los cortes de hoja y es por eso que tienes cojas con 3 cuadros, o 2 cuadros, etc.
Para realizar la impresión y acomodar 6 cuadros en cada hoja, se deben realizar varios pasos:
1. Te actualizo las macros que hacen los filtros.
El principal cambio, es que ahora empieza el filtro en la fila 5.
Option Explicit
'
Private Sub CheckBox1_Click()
Call Filtrar
End Sub
Private Sub CheckBox2_Click()
Call Filtrar
End Sub
Private Sub CheckBox3_Click()
Call Filtrar
End Sub
'
Sub Filtrar()
Dim n As Long
Dim arr() As Variant
n = -1
If CheckBox1 Then
n = n + 1
ReDim Preserve arr(n)
arr(n) = "Transferencia con un Débito"
End If
If CheckBox2 Then
n = n + 1
ReDim Preserve arr(n)
arr(n) = "Transferencia con un Crédito"
End If
If CheckBox3 Then
n = n + 1
ReDim Preserve arr(n)
arr(n) = "Financiamiento"
End If
Call desproteger
Application.ScreenUpdating = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
If n > -1 Then
Range("A5", Range("L" & Rows.Count).End(3)).AutoFilter 12, Array(arr), xlFilterValues
End If
Range("L2").Select
Application.ScreenUpdating = True
Call proteger
End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim f As Range
'
If Target.CountLarge > 1 Then Exit Sub
If Target.Address = "$K$5" Then
Call desproteger
Application.ScreenUpdating = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
If Target.Value <> "" Then
Set f = Range("B:B").Find(Target.Value, , xlValues, xlWhole)
If Not f Is Nothing Then
Range("A6", Range("L" & Rows.Count).End(3)).AutoFilter 1, Target.Value
Else
MsgBox "No existe el renglón presupuestario", vbInformation + vbOKOnly, "Aviso para Intecap"
Range("K5").ClearContents
End If
End If
Range("K5").Select
Application.ScreenUpdating = False
Call proteger
End If
End Sub
'
Sub proteger()
Worksheets("RENGLONES").Protect ("regional2018")
End Sub
'
Sub desproteger()
Worksheets("RENGLONES").Unprotect ("regional2018")
End Sub2. Debes crear una hoja llamada "Impresion".
3. Para hacer la impresión de lo filtrado o de lo que tengas en la hoja "RENGLONES", se debe copiar la información filtrada de "RENGLONES" y pegar en la hoja "impresion".
Ya con la información en la hoja "impresion", se deben ajustar los saltos de hoja.
4. Te preparé una macro para imprimir, copia la información en la hoja "impresion", ajusta los saltos de hoja y te deja lista la hoja "impresion" para imprimir.
Sub impresion()
Dim h1 As Worksheet, h2 As Worksheet
Dim u1 As Long, u2 As Long, n As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set h1 = Sheets("RENGLONES")
Set h2 = Sheets("Impresion")
h2.Cells.Clear
u1 = h1.Range("D" & Rows.Count).End(3).Row
h1.Range("A1:I" & u1).Copy
h2.Range("A1").PasteSpecial xlPasteColumnWidths
h2.Range("A1").PasteSpecial xlPasteValues
h2.Range("A1").PasteSpecial xlPasteFormats
h2.PageSetup.PrintArea = ""
h2.ResetAllPageBreaks
'
On Error Resume Next
For n = 1 To h2.HPageBreaks.Count
h2.HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1
Next
On Error GoTo 0
'
Call Macro4(h2)
u2 = h2.Range("D" & Rows.Count).End(3).Row
h2.PageSetup.PrintArea = "A1:I" & u2
'
For n = 71 To u2 Step 66
h2.HPageBreaks.Add Before:=h2.Range("A" & n)
Next
End Sub[Recuerda valorar la respuesta.
