quiero agregar un botón para imprimir la lista de clientes con datos completos,
tambien que ese boton imprimir pueda elegir de un check list los datos de la base
de dato que quiro unicamente, ejemplo si quiero solo la lista de clientes que no
hayan pagado.
Perfecto — te doy una solución lista para implementar. La idea:
Crear un UserForm (frmPrintClients) con una lista para elegir columnas y
controles para filtros (estado y "sin pagos").
El formulario genera una hoja de reporte (4_Reportes), copia solo las
columnas seleccionadas y aplica los filtros (ej.: sólo clientes sin pagos).
Muestra una vista previa de impresión (puedes cambiar a impresión
directa).
Instrucciones para el UserForm (nombres de controles que usaremos —
crea estos en el diseñador de UserForm):
UserForm name: frmPrintClients
ListBox (MultiSelect = fmMultiSelectMulti): lstColumns
ComboBox: cboEstado
CheckBox: chkSinPagos (Caption: "Solo clientes sin pagos")
CommandButton: btnPrint (Caption: "Generar / Vista previa")
CommandButton: btnClose (Caption: "Cerrar")
Suposiciones (ajusta si tu estructura es distinta):
Tabla de clientes: hoja "1_DatosClientes", tabla ListObject llamada
"tblClientes". La columna 1 = Cédula, la columna 8 = Estado.
Tabla de pagos: hoja "2_Pagos", tabla ListObject llamada "tblPagos". La
columna 1 de tblPagos contiene la cédula del cliente (usada para saber
si el cliente tiene pagos).
Código a agregar:
1. 1Módulo estándar: ShowPrintClientsForm y función que verifica pagos
Option Explicit
' Llamar para mostrar el formulario
Sub ShowPrintClientsForm()
frmPrintClients.Show
End Sub
' Retorna True si existe al menos un pago para la cédula indicada en tblPagos
Public Function ClientHasPayments(ByVal ced As String) As Boolean
Dim ws As Worksheet
Dim tbl As ListObject
Dim v As Variant
ced = Trim(ced)
If ced = "" Then
ClientHasPayments = False
Exit Function
End If
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("2_Pagos")
Set tbl = ws.ListObjects("tblPagos")
On Error GoTo 0
If tbl Is Nothing Then
ClientHasPayments = False
Exit Function
End If
If tbl.ListRows.Count = 0 Then
ClientHasPayments = False
Exit Function
End If
On Error Resume Next
v = Application.Match(ced, tbl.DataBodyRange.Columns(1), 0)
On Error GoTo 0
If IsError(v) Or IsEmpty(v) Then
ClientHasPayments = False
Else
ClientHasPayments = True
End If
End Function
2. Código del UserForm (módulo de código del formulario frmPrintClients):
Option Explicit
' Inicializar el formulario: cargar columnas y estados
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim tbl As ListObject
Dim hdr As Range
Dim i As Long
Dim dict As Object
Dim val As String
On Error GoTo ErrHandler
Set ws = ThisWorkbook.Worksheets("1_DatosClientes")
Set tbl = ws.ListObjects("tblClientes")
Set hdr = tbl.HeaderRowRange
' Cargar encabezados en la ListBox
Me.lstColumns.Clear
For i = 1 To hdr.Columns.Count
Me.lstColumns.AddItem CStr(hdr.Cells(1, i).Value)
Me.lstColumns.Selected(i - 1) = True ' seleccionar por defecto todas
Next i
' Poblar combo de estados (distintos) + "(Todos)"
Set dict = CreateObject("Scripting.Dictionary")
Me.cboEstado.Clear
Me.cboEstado.AddItem "(Todos)"
If tbl.ListRows.Count > 0 Then
For i = 1 To tbl.ListRows.Count
val = CStr(tbl.DataBodyRange(i, 8).Value) ' columna 8 = Estado (ajusta si corresponde)
val = Trim(val)
If val <> "" Then
If Not dict.Exists(val) Then dict.Add val, val
End If
Next i
Dim k
For Each k In dict.Keys
Me.cboEstado.AddItem k
Next k
End If
Me.cboEstado.ListIndex = 0
Exit Sub
ErrHandler:
MsgBox "Error inicializando formulario: " & Err.Description, vbExclamation
End Sub
' Botón Generar / Vista previa
Private Sub btnPrint_Click()
Dim wsSrc As Worksheet, wsDst As Worksheet
Dim tbl As ListObject
Dim selectedCols As Collection
Dim i As Long, j As Long
Dim nextRow As Long
Dim hdr As Range
Dim colIndex As Long
Dim ced As String
Dim passesFilter As Boolean
Dim estadoFiltro As String
On Error GoTo ErrHandler
Set wsSrc = ThisWorkbook.Worksheets("1_DatosClientes")
Set tbl = wsSrc.ListObjects("tblClientes")
If tbl Is Nothing Then
MsgBox "No se encontró la tabla 'tblClientes'.", vbExclamation
Exit Sub
End If
' Recolectar columnas seleccionadas (posiciones relativas dentro de la tabla)
Set selectedCols = New Collection
For i = 0 To Me.lstColumns.ListCount - 1
If Me.lstColumns.Selected(i) Then
' las posiciones de ListBox comienzan en 0; las columnas de la tabla en 1
selectedCols.Add i + 1
End If
Next i
If selectedCols.Count = 0 Then
MsgBox "Selecciona al menos una columna para imprimir.", vbExclamation
Exit Sub
End If
estadoFiltro = ""
If Me.cboEstado.ListIndex > 0 Then
estadoFiltro = CStr(Me.cboEstado.Value)
End If
' Preparar hoja destino
On Error Resume Next
Set wsDst = ThisWorkbook.Worksheets("4_Reportes")
If wsDst Is Nothing Then
Set wsDst =
ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Cou
nt))
wsDst.Name = "4_Reportes"
Else
wsDst.Cells.Clear
End If
On Error GoTo 0
Set hdr = tbl.HeaderRowRange
' Escribir encabezados seleccionados
For j = 1 To selectedCols.Count
colIndex = selectedCols(j)
wsDst.Cells(1, j).Value = hdr.Cells(1, colIndex).Value
' opcional: copiar formato del header
hdr.Cells(1, colIndex).Copy
wsDst.Cells(1, j).PasteSpecial xlPasteFormats
Next j
nextRow = 2
' Recorrer filas de la tabla y aplicar filtros
If tbl.ListRows.Count > 0 Then
For i = 1 To tbl.ListRows.Count
ced = CStr(tbl.DataBodyRange(i, 1).Value) ' columna 1 = cédula
passesFilter = True
' filtro por estado si se seleccionó uno distinto a (Todos)
If estadoFiltro <> "" Then
If CStr(tbl.DataBodyRange(i, 8).Value) <> estadoFiltro Then ' col 8 = Estado
passesFilter = False
End If
End If
' filtro "Solo sin pagos"
If passesFilter And Me.chkSinPagos.Value = True Then
If ClientHasPayments(ced) Then passesFilter = False
End If
If passesFilter Then
' copiar columnas seleccionadas
For j = 1 To selectedCols.Count
colIndex = selectedCols(j)
wsDst.Cells(nextRow, j).Value = tbl.DataBodyRange(i, colIndex).Value
Next j
nextRow = nextRow + 1
End If
Next i
End If
' Si no se copiaron filas -> avisar
If nextRow = 2 Then
MsgBox "No hay registros que cumplan los filtros seleccionados.", vbInformation
Exit Sub
End If
' Formato y página
wsDst.Columns.AutoFit
With wsDst.PageSetup
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
' Vista previa de impresión
wsDst.PrintPreview
Exit Sub
ErrHandler:
MsgBox "Error generando el reporte: " & Err.Description, vbExclamation
End Sub
Private Sub btnClose_Click()
Unload Me
End Sub
Notas y ajustes importantes:
Si la columna "Estado" no está en la columna 8 en tblClientes, cambia
las referencias tbl.DataBodyRange(i, 8) por la columna correcta.
Si en tblPagos la cédula no está en la columna 1, ajusta
ClientHasPayments para usar la columna correcta.
Si quieres permitir filtros adicionales (p. ej. fecha de alta, servicio,
buscador por nombre), puedo agregar más controles al formulario y el
código correspondiente.
Actualmente se hace PrintPreview; para imprimir directamente
reemplaza wsDst.PrintPreview por wsDst.PrintOut (y ajusta copias /
impresora si necesitas).
Si deseas exportar a PDF en lugar de imprimir, puedo añadir código para
exportar la hoja "4_Reportes" a PDF y guardarlo en una carpeta.
¿Quieres que adapte esto a columnas con otros nombres/índices o que
agregue más filtros (por ejemplo: servicio, rango de fecha, clientes
morosos según saldo, exportar a PDF)?
