VERSION 5.00
Begin VB.Form frmReporteActivo 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Reporte"
   ClientHeight    =   1395
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4920
   Icon            =   "frmReporteActivo.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1395
   ScaleWidth      =   4920
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdMensaje 
      Caption         =   "Espere un momento. Generando Reporte ..."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   6
      Top             =   600
      Visible         =   0   'False
      Width           =   4695
   End
   Begin VB.CommandButton cmdEstandar 
      Caption         =   "&Aceptar"
      Default         =   -1  'True
      Height          =   375
      Index           =   0
      Left            =   2040
      TabIndex        =   0
      Top             =   960
      Width           =   1335
   End
   Begin VB.CommandButton cmdEstandar 
      Cancel          =   -1  'True
      Caption         =   "&Cancelar"
      Height          =   375
      Index           =   1
      Left            =   3480
      TabIndex        =   1
      Top             =   960
      Width           =   1335
   End
   Begin VB.Frame fraActivo 
      Height          =   855
      Left            =   120
      TabIndex        =   5
      Top             =   0
      Width           =   4695
      Begin VB.OptionButton optActivo 
         Caption         =   "Todos"
         Height          =   255
         Index           =   2
         Left            =   3360
         TabIndex        =   4
         Top             =   360
         Width           =   975
      End
      Begin VB.OptionButton optActivo 
         Caption         =   "Activos"
         Height          =   255
         Index           =   1
         Left            =   1800
         TabIndex        =   3
         Top             =   360
         Width           =   975
      End
      Begin VB.OptionButton optActivo 
         Caption         =   "Inactivos"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   975
      End
   End
End
Attribute VB_Name = "frmReporteActivo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()

  'Carga el formulario

  On Error GoTo LineaError

  Screen.MousePointer = vbHourglass
  
  InicializarForm
  
  Screen.MousePointer = vbDefault
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  Screen.MousePointer = vbDefault

End Sub

Private Sub InicializarForm()

  'Inicializa el Form
  
  On Error GoTo LineaError
  
  Call CentrarControl(Me, cmdMensaje)
  
  If frmPrincipal.iMnuReporte = kMNU_REPORTE_CLIENTE Then
    Me.Caption = "Relación de Clientes"
  ElseIf frmPrincipal.iMnuReporte = kMNU_REPORTE_PREMIO Then
    Me.Caption = "Relación de Premios"
  ElseIf frmPrincipal.iMnuReporte = kMNU_REPORTE_USUARIO Then
    Me.Caption = "Relación de Usuarios"
  End If

  optActivo(kSI).Value = True
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub cmdEstandar_Click(Index As Integer)

  'Acepta o Cancela Generación del reporte
  
  Screen.MousePointer = vbHourglass
  
  On Error GoTo LineaError
  
  Select Case Index
  
  Case kCMD_ACEPTAR
  
    If frmPrincipal.iMnuReporte = kMNU_REPORTE_CLIENTE Then
      If Not ReporteCliente Then GoTo Salir
    ElseIf frmPrincipal.iMnuReporte = kMNU_REPORTE_PREMIO Then
      If Not ReportePremio Then GoTo Salir
    ElseIf frmPrincipal.iMnuReporte = kMNU_REPORTE_USUARIO Then
      If Not ReporteUsuario Then GoTo Salir
    End If
  
  Case kCMD_CANCELAR
    
  End Select
  
  Unload Me
  
  GoTo Salir

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Screen.MousePointer = vbDefault

End Sub

Private Function ReporteCliente() As Boolean

  'Genera Reporte Relacion de Clientes
  
  On Error GoTo LineaError
  
  Dim xlApp As Excel.Application
  Dim xlBook As Excel.Workbook
  Dim xlSheet As Excel.Worksheet
  Dim xlSheetTemp As Excel.Worksheet
  
  Dim lFila As Long
  
  ReporteCliente = False
  
  cmdMensaje.Visible = True
  
  Set xlApp = CreateObject("excel.application")
  Set xlBook = xlApp.Workbooks.Add
  Set xlSheet = xlBook.Worksheets.Add
  
  xlSheet.Name = "Clientes"
  
  xlBook.Application.DisplayAlerts = False
  
  For Each xlSheetTemp In xlBook.Worksheets
    If xlSheetTemp.Name <> xlSheet.Name Then
      xlSheetTemp.Delete
    End If
  Next xlSheetTemp
  
  xlBook.Application.DisplayAlerts = True
  
  'Formato Página
  xlSheet.PageSetup.Orientation = xlLandscape
  xlSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.3)
  xlSheet.PageSetup.RightMargin = Application.InchesToPoints(0.3)
  xlSheet.PageSetup.TopMargin = Application.InchesToPoints(0.5)
  xlSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.5)
  xlSheet.PageSetup.HeaderMargin = Application.InchesToPoints(0.1)
  xlSheet.PageSetup.FooterMargin = Application.InchesToPoints(0.1)
  xlSheet.PageSetup.PrintTitleRows = xlSheet.Rows("1:4").Address
    
  'Cabecera / Pie de Página
  xlSheet.PageSetup.LeftHeader = "&6Moy Park"
  xlSheet.PageSetup.RightHeader = "&6" + "Sistema de Afiliación de Clientes"
  xlSheet.PageSetup.RightFooter = "&6página &P"
  
  'Columna
  xlSheet.Columns(1).ColumnWidth = 32
  xlSheet.Columns(2).ColumnWidth = 8
  xlSheet.Columns(3).ColumnWidth = 8
  xlSheet.Columns(4).ColumnWidth = 16
  xlSheet.Columns(5).ColumnWidth = 10
  xlSheet.Columns(6).ColumnWidth = 15
  xlSheet.Columns(7).ColumnWidth = 7
  xlSheet.Columns(8).ColumnWidth = 7
  xlSheet.Columns(9).ColumnWidth = 8
  xlSheet.Columns(10).ColumnWidth = 20
  
  lFila = 1
  
  'Título
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + 1, 1)).NumberFormat = "@"
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + 1, 1)).Font.Bold = True
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + 1, 1)).Font.Size = 11
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + 1, 1)).HorizontalAlignment = xlCenter
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Merge
  xlSheet.Range(xlSheet.Cells(lFila + 1, 1), xlSheet.Cells(lFila + 1, 10)).Merge
  
  If optActivo(kNO).Value Then
    xlSheet.Cells(lFila, 1).Value = "RELACION DE CLIENTES INACTIVOS"
  ElseIf optActivo(kSI).Value Then
    xlSheet.Cells(lFila, 1).Value = "RELACION DE CLIENTES ACTIVOS"
  Else
    xlSheet.Cells(lFila, 1).Value = "RELACION DE CLIENTES ACTIVOS E INACTIVOS"
  End If
  
  lFila = lFila + 3
   
  'SubTítulo
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).NumberFormat = "@"
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Font.Bold = True
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Font.Size = 8
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).HorizontalAlignment = xlCenter
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders.LineStyle = xlContinuous
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders.Weight = 2
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders(xlEdgeTop).Weight = 3
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders(xlEdgeBottom).Weight = 3
  xlSheet.Cells(lFila, 1).Borders(xlEdgeLeft).Weight = 3
  xlSheet.Cells(lFila, 3).Borders(xlEdgeRight).Weight = 3
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Interior.ColorIndex = 15
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Interior.Pattern = xlSolid
  
  xlSheet.Cells(lFila, 1).Value = "Nombre"
  xlSheet.Cells(lFila, 2).Value = "F.Nacim."
  xlSheet.Cells(lFila, 3).Value = "Tarj.Activa"
  xlSheet.Cells(lFila, 4).Value = "Tarj.Inctivas"
  xlSheet.Cells(lFila, 5).Value = "Telefono"
  xlSheet.Cells(lFila, 6).Value = "E-Mail"
  xlSheet.Cells(lFila, 7).Value = "Puntos"
  xlSheet.Cells(lFila, 8).Value = "Tickets"
  xlSheet.Cells(lFila, 9).Value = "F.Ult.Tran."
  xlSheet.Cells(lFila, 10).Value = "Ult.Transacción"
  
  lFila = lFila + 1
  
  If optActivo(kTODOS).Value Then
  
    lFila = lFila + 1
  
    xlSheet.Cells(lFila, 1).NumberFormat = "@"
    xlSheet.Cells(lFila, 1).Font.Bold = True
    xlSheet.Cells(lFila, 1).Font.Size = 8
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders.LineStyle = xlContinuous
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders.Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Merge
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Interior.ColorIndex = 15
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Interior.Pattern = xlSolid
    
    xlSheet.Cells(lFila, 1).Value = "CLIENTES ACTIVOS"
    
    lFila = lFila + 1
    
  End If
  
  If optActivo(kTODOS).Value Or optActivo(kSI).Value Then
    If Not ReporteClienteDatos(xlSheet, lFila, kSI) Then GoTo LineaError1
  End If
  
  If optActivo(kTODOS).Value Then
  
    lFila = lFila + 1
  
    xlSheet.Cells(lFila, 1).NumberFormat = "@"
    xlSheet.Cells(lFila, 1).Font.Bold = True
    xlSheet.Cells(lFila, 1).Font.Size = 8
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders.LineStyle = xlContinuous
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders.Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Merge
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Interior.ColorIndex = 15
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Interior.Pattern = xlSolid
    
    xlSheet.Cells(lFila, 1).Value = "CLIENTES INACTIVOS"
    
    lFila = lFila + 1
    
  End If
  
  If optActivo(kTODOS).Value Or optActivo(kNO).Value Then
    If Not ReporteClienteDatos(xlSheet, lFila, kNO) Then GoTo LineaError1
  End If
  
  'Mostrar
  xlApp.WindowState = xlMaximized
  xlApp.Visible = True
  
  ReporteCliente = True
    
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
LineaError1:
  
  On Error Resume Next

  xlBook.Close False
  xlApp.Quit

Salir:

  On Error Resume Next
  
  Set xlSheetTemp = Nothing
  Set xlSheet = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing
  
  cmdMensaje.Visible = False
  
End Function

Private Function ReporteClienteDatos(xlSheet As Excel.Worksheet, lFila As Long, ioptActivo As Integer) As Boolean

  'Inserta la parte de datos en el reporte
  
  On Error GoTo LineaError
  
  Dim lRegistros As Long
  Dim l As Long
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  Dim ADORS1 As ADODB.Recordset
  
  Dim sTarjetaActiva As String
  Dim sTarjetaInactiva As String
  
  ReporteClienteDatos = False
  
  sSQL = "SELECT DISTINCT cClieCode, sClieApel + ' ' + sClieName as sName, " + _
           "dNacmDate, sClieTelf, sClieMail, " + _
           "nPuntCant, nTickCant, dUltTDate, sTranDesc " + _
           "FROM Cliente a, Transaccion b " + _
           "WHERE a.cTranCode = b.cTranCode AND " + _
           "cClieCode $ IN (SELECT cClieCode FROM Tarjeta WHERE cTarjActi = $) "
  sSQL = VBsprintf(sSQL, IIf(ioptActivo = kSI, "", "NOT"), kSI)
    
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
  lRegistros = ADORS.RecordCount
    
  If lRegistros <> 0 Then
    
    'Datos
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 10)).NumberFormat = "@"
    xlSheet.Range(xlSheet.Cells(lFila, 7), xlSheet.Cells(lFila + lRegistros - 1, 8)).NumberFormat = "##,##0"
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 10)).Font.Size = 8
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 10)).HorizontalAlignment = xlLeft
    xlSheet.Range(xlSheet.Cells(lFila, 7), xlSheet.Cells(lFila + lRegistros - 1, 8)).HorizontalAlignment = xlRight
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 10)).Borders.LineStyle = xlContinuous
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 10)).Borders.Weight = 2
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders(xlEdgeTop).Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila + lRegistros - 1, 1), xlSheet.Cells(lFila + lRegistros - 1, 10)).Borders(xlEdgeBottom).Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 1)).Borders(xlEdgeLeft).Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila, 10), xlSheet.Cells(lFila + lRegistros - 1, 10)).Borders(xlEdgeRight).Weight = 3
  
    For l = 1 To lRegistros
    
      sTarjetaActiva = ""
      sTarjetaInactiva = ""
    
      sSQL = "SELECT nTarjNumb, cTarjActi FROM Tarjeta WHERE cClieCode = $"
      sSQL = VBsprintf(sSQL, LeerCampo(ADORS!cClieCode))
      If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS1) Then GoTo Salir
      
      Do While Not ADORS1.EOF
    
        If LeerCampo(ADORS1!cTarjActi) = kSI Then
          sTarjetaActiva = sTarjetaActiva + " - " + LeerCampo(ADORS1!nTarjNumb)
        Else
          sTarjetaInactiva = sTarjetaInactiva + " - " + LeerCampo(ADORS1!nTarjNumb)
        End If
        
        ADORS1.MoveNext
        
      Loop
    
      xlSheet.Cells(lFila, 1) = LeerCampo(ADORS!sName)
      xlSheet.Cells(lFila, 2) = Format(LeerCampo(ADORS!dNacmDate), "dd/mm/yyyy")
      xlSheet.Cells(lFila, 3) = Mid(sTarjetaActiva, 4)
      xlSheet.Cells(lFila, 4) = Mid(sTarjetaInactiva, 4)
      xlSheet.Cells(lFila, 5) = LeerCampo(ADORS!sClieTelf)
      xlSheet.Cells(lFila, 6) = LeerCampo(ADORS!sClieMail)
      xlSheet.Cells(lFila, 7) = Format(LeerCampo(ADORS!nPuntCant), "##,##0")
      xlSheet.Cells(lFila, 8) = Format(LeerCampo(ADORS!nTickCant), "##,##0")
      xlSheet.Cells(lFila, 9) = Format(LeerCampo(ADORS!dUltTDate), "dd/mm/yyyy")
      xlSheet.Cells(lFila, 10) = LeerCampo(ADORS!sTranDesc)
      
      ADORS.MoveNext
        
      lFila = lFila + 1
    
    Next
    
  End If
  
  'Total
  xlSheet.Cells(lFila, 1).NumberFormat = "@"
  xlSheet.Cells(lFila, 1).Font.Bold = True
  xlSheet.Cells(lFila, 1).Font.Size = 8
  xlSheet.Cells(lFila, 1).HorizontalAlignment = xlLeft
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders.LineStyle = xlContinuous
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Borders.Weight = 3
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 10)).Merge
  
  xlSheet.Cells(lFila, 1) = "Total: " + Format(lRegistros, "##,##0")
  
  lFila = lFila + 1
  
  ReporteClienteDatos = True
    
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
  Set ADORS1 = Nothing
  
End Function

Private Function ReportePremio() As Boolean

  'Genera Reporte Relacion de Premios
  
  On Error GoTo LineaError
  
  Dim xlApp As Excel.Application
  Dim xlBook As Excel.Workbook
  Dim xlSheet1 As Excel.Worksheet
  Dim xlSheet2 As Excel.Worksheet
  Dim xlSheetTemp As Excel.Worksheet
  
  Dim lFila1 As Long
  Dim lFila2 As Long
  
  ReportePremio = False
  
  cmdMensaje.Visible = True
  
  Set xlApp = CreateObject("excel.application")
  Set xlBook = xlApp.Workbooks.Add
  Set xlSheet1 = xlBook.Worksheets.Add
  Set xlSheet2 = xlBook.Worksheets.Add
  
  xlSheet1.Name = "Puntos"
  xlSheet2.Name = "Tickets"
  
  xlBook.Application.DisplayAlerts = False
  
  For Each xlSheetTemp In xlBook.Worksheets
    If xlSheetTemp.Name <> xlSheet1.Name And xlSheetTemp.Name <> xlSheet2.Name Then
      xlSheetTemp.Delete
    End If
  Next xlSheetTemp
  
  xlBook.Application.DisplayAlerts = True
  
  'Formato Página
  xlSheet1.PageSetup.Orientation = xlPortrait
  xlSheet1.PageSetup.LeftMargin = Application.InchesToPoints(0.3)
  xlSheet1.PageSetup.RightMargin = Application.InchesToPoints(0.3)
  xlSheet1.PageSetup.TopMargin = Application.InchesToPoints(0.5)
  xlSheet1.PageSetup.BottomMargin = Application.InchesToPoints(0.5)
  xlSheet1.PageSetup.HeaderMargin = Application.InchesToPoints(0.1)
  xlSheet1.PageSetup.FooterMargin = Application.InchesToPoints(0.1)
  xlSheet1.PageSetup.PrintTitleRows = xlSheet1.Rows("1:4").Address
  
  xlSheet2.PageSetup.Orientation = xlPortrait
  xlSheet2.PageSetup.LeftMargin = Application.InchesToPoints(0.3)
  xlSheet2.PageSetup.RightMargin = Application.InchesToPoints(0.3)
  xlSheet2.PageSetup.TopMargin = Application.InchesToPoints(0.5)
  xlSheet2.PageSetup.BottomMargin = Application.InchesToPoints(0.5)
  xlSheet2.PageSetup.HeaderMargin = Application.InchesToPoints(0.1)
  xlSheet2.PageSetup.FooterMargin = Application.InchesToPoints(0.1)
  xlSheet2.PageSetup.PrintTitleRows = xlSheet1.Rows("1:4").Address
    
  'Cabecera / Pie de Página
  xlSheet1.PageSetup.LeftHeader = "&6Moy Park"
  xlSheet1.PageSetup.RightHeader = "&6" + "Sistema de Afiliación de Clientes"
  xlSheet1.PageSetup.RightFooter = "&6página &P"
  
  xlSheet2.PageSetup.LeftHeader = "&6Moy Park"
  xlSheet2.PageSetup.RightHeader = "&6" + "Sistema de Afiliación de Clientes"
  xlSheet2.PageSetup.RightFooter = "&6página &P"
  
  'Columna
  xlSheet1.Columns(1).ColumnWidth = 75
  xlSheet1.Columns(2).ColumnWidth = 15
  
  xlSheet2.Columns(1).ColumnWidth = 25
  xlSheet2.Columns(2).ColumnWidth = 50
  xlSheet2.Columns(3).ColumnWidth = 9
  xlSheet2.Columns(4).ColumnWidth = 9
  
  lFila1 = 1
  lFila2 = 1
  
  'Título
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + 1, 1)).NumberFormat = "@"
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + 1, 1)).Font.Bold = True
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + 1, 1)).Font.Size = 11
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + 1, 1)).HorizontalAlignment = xlCenter
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Merge
  xlSheet1.Range(xlSheet1.Cells(lFila1 + 1, 1), xlSheet1.Cells(lFila1 + 1, 2)).Merge
  
  If optActivo(kNO).Value Then
    xlSheet1.Cells(lFila1, 1).Value = "RELACION DE PREMIOS (PUNTOS) INACTIVOS"
  ElseIf optActivo(kSI).Value Then
    xlSheet1.Cells(lFila1, 1).Value = "RELACION DE PREMIOS (PUNTOS) ACTIVOS"
  Else
    xlSheet1.Cells(lFila1, 1).Value = "RELACION DE PREMIOS (PUNTOS) ACTIVOS E INACTIVOS"
  End If
  
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila1 + 1, 1)).NumberFormat = "@"
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila1 + 1, 1)).Font.Bold = True
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila1 + 1, 1)).Font.Size = 11
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila1 + 1, 1)).HorizontalAlignment = xlCenter
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila1, 4)).Merge
  xlSheet2.Range(xlSheet2.Cells(lFila2 + 1, 1), xlSheet2.Cells(lFila1 + 1, 4)).Merge
  
  If optActivo(kNO).Value Then
    xlSheet2.Cells(lFila2, 1).Value = "RELACION DE PREMIOS (TICKETS) INACTIVOS"
  ElseIf optActivo(kSI).Value Then
    xlSheet2.Cells(lFila2, 1).Value = "RELACION DE PREMIOS (TICKETS) ACTIVOS"
  Else
    xlSheet2.Cells(lFila2, 1).Value = "RELACION DE PREMIOS (TICKETS) ACTIVOS E INACTIVOS"
  End If
  
  lFila1 = lFila1 + 3
  lFila2 = lFila2 + 3
   
  'SubTítulo
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).NumberFormat = "@"
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Font.Bold = True
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Font.Size = 8
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).HorizontalAlignment = xlCenter
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders.LineStyle = xlContinuous
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders.Weight = 2
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders(xlEdgeTop).Weight = 3
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders(xlEdgeBottom).Weight = 3
  xlSheet1.Cells(lFila1, 1).Borders(xlEdgeLeft).Weight = 3
  xlSheet1.Cells(lFila1, 2).Borders(xlEdgeRight).Weight = 3
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Interior.ColorIndex = 15
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Interior.Pattern = xlSolid
  
  xlSheet1.Cells(lFila1, 1).Value = "Premio"
  xlSheet1.Cells(lFila1, 2).Value = "Puntos Req."
  
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).NumberFormat = "@"
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Font.Bold = True
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Font.Size = 8
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).HorizontalAlignment = xlCenter
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Borders.LineStyle = xlContinuous
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Borders.Weight = 2
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Borders(xlEdgeTop).Weight = 3
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Borders(xlEdgeBottom).Weight = 3
  xlSheet2.Cells(lFila2, 1).Borders(xlEdgeLeft).Weight = 3
  xlSheet2.Cells(lFila2, 4).Borders(xlEdgeRight).Weight = 3
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Interior.ColorIndex = 15
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Interior.Pattern = xlSolid
  
  xlSheet2.Cells(lFila2, 1).Value = "Premio"
  xlSheet2.Cells(lFila2, 2).Value = "Comentario"
  xlSheet2.Cells(lFila2, 3).Value = "Stock"
  xlSheet2.Cells(lFila2, 4).Value = "Tickets Req."
  
  lFila1 = lFila1 + 1
  lFila2 = lFila2 + 1
  
  If optActivo(kTODOS).Value Then
  
    lFila1 = lFila1 + 1
    lFila2 = lFila2 + 1
  
    xlSheet1.Cells(lFila1, 1).NumberFormat = "@"
    xlSheet1.Cells(lFila1, 1).Font.Bold = True
    xlSheet1.Cells(lFila1, 1).Font.Size = 8
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders.LineStyle = xlContinuous
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders.Weight = 3
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Merge
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Interior.ColorIndex = 15
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Interior.Pattern = xlSolid
    
    xlSheet1.Cells(lFila1, 1).Value = "PREMIOS ACTIVOS"
    
    xlSheet2.Cells(lFila2, 1).NumberFormat = "@"
    xlSheet2.Cells(lFila2, 1).Font.Bold = True
    xlSheet2.Cells(lFila2, 1).Font.Size = 8
    xlSheet2.Range(xlSheet2.Cells(lFila1, 1), xlSheet2.Cells(lFila2, 4)).Borders.LineStyle = xlContinuous
    xlSheet2.Range(xlSheet2.Cells(lFila1, 1), xlSheet2.Cells(lFila2, 4)).Borders.Weight = 3
    xlSheet2.Range(xlSheet2.Cells(lFila1, 1), xlSheet2.Cells(lFila2, 4)).Merge
    xlSheet2.Range(xlSheet2.Cells(lFila1, 1), xlSheet2.Cells(lFila2, 4)).Interior.ColorIndex = 15
    xlSheet2.Range(xlSheet2.Cells(lFila1, 1), xlSheet2.Cells(lFila2, 4)).Interior.Pattern = xlSolid
    
    xlSheet2.Cells(lFila2, 1).Value = "PREMIOS ACTIVOS"
    
    lFila1 = lFila1 + 1
    lFila2 = lFila2 + 1
    
  End If
  
  If optActivo(kTODOS).Value Or optActivo(kSI).Value Then
    If Not ReportePremioDatos(xlSheet1, lFila1, xlSheet2, lFila2, kSI) Then GoTo LineaError1
  End If
  
  If optActivo(kTODOS).Value Then
  
    lFila1 = lFila1 + 1
    lFila2 = lFila2 + 1
  
    xlSheet1.Cells(lFila1, 1).NumberFormat = "@"
    xlSheet1.Cells(lFila1, 1).Font.Bold = True
    xlSheet1.Cells(lFila1, 1).Font.Size = 8
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders.LineStyle = xlContinuous
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders.Weight = 3
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Merge
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Interior.ColorIndex = 15
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Interior.Pattern = xlSolid
    
    xlSheet1.Cells(lFila1, 1).Value = "PREMIOS INACTIVOS"
    
    xlSheet2.Cells(lFila2, 1).NumberFormat = "@"
    xlSheet2.Cells(lFila2, 1).Font.Bold = True
    xlSheet2.Cells(lFila2, 1).Font.Size = 8
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Borders.LineStyle = xlContinuous
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Borders.Weight = 3
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Merge
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Interior.ColorIndex = 15
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Interior.Pattern = xlSolid
    
    xlSheet2.Cells(lFila2, 1).Value = "PREMIOS INACTIVOS"
    
    lFila1 = lFila1 + 1
    lFila2 = lFila2 + 1
    
  End If
  
  If optActivo(kTODOS).Value Or optActivo(kNO).Value Then
    If Not ReportePremioDatos(xlSheet1, lFila1, xlSheet2, lFila2, kNO) Then GoTo LineaError1
  End If
  
  'Mostrar
  xlApp.WindowState = xlMaximized
  xlApp.Visible = True
  
  ReportePremio = True
    
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
LineaError1:
  
  On Error Resume Next

  xlBook.Close False
  xlApp.Quit
  
Salir:

  On Error Resume Next
   
  Set xlSheetTemp = Nothing
  Set xlSheet1 = Nothing
  Set xlSheet2 = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing
  
  cmdMensaje.Visible = False
  
End Function

Private Function ReportePremioDatos(xlSheet1 As Excel.Worksheet, lFila1 As Long, xlSheet2 As Excel.Worksheet, lFila2 As Long, ioptActivo As Integer) As Boolean

  'Inserta la parte de datos en el reporte
  
  On Error GoTo LineaError
  
  Dim lRegistros1 As Long
  Dim lRegistros2 As Long
  Dim l As Long
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  ReportePremioDatos = False
  
  sSQL = "SELECT * " + _
         "FROM Premio_Punto " + _
         "WHERE cPremActi = $ " + _
         "ORDER BY sPremDesc"
  sSQL = VBsprintf(sSQL, ioptActivo)
    
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
  lRegistros1 = ADORS.RecordCount
    
  If lRegistros1 <> 0 Then
    
    'Datos
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 2)).NumberFormat = "@"
    xlSheet1.Range(xlSheet1.Cells(lFila1, 2), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 2)).NumberFormat = "##,##0"
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 2)).Font.Size = 8
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 2)).HorizontalAlignment = xlLeft
    xlSheet1.Range(xlSheet1.Cells(lFila1, 2), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 2)).HorizontalAlignment = xlRight
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 2)).Borders.LineStyle = xlContinuous
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 2)).Borders.Weight = 2
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders(xlEdgeTop).Weight = 3
    xlSheet1.Range(xlSheet1.Cells(lFila1 + lRegistros1 - 1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 2)).Borders(xlEdgeBottom).Weight = 3
    xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 1)).Borders(xlEdgeLeft).Weight = 3
    xlSheet1.Range(xlSheet1.Cells(lFila1, 2), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 2)).Borders(xlEdgeRight).Weight = 3
  
    For l = 1 To lRegistros1
    
      xlSheet1.Cells(lFila1, 1) = LeerCampo(ADORS!sPremDesc)
      xlSheet1.Cells(lFila1, 2) = Format(LeerCampo(ADORS!nPuntCant), "##,##0")
      
      ADORS.MoveNext
        
      lFila1 = lFila1 + 1
    
    Next
    
  End If
  
  sSQL = "SELECT * " + _
         "FROM Premio_Ticket " + _
         "WHERE cPremActi = $ " + _
         "ORDER BY sPremDesc"
  sSQL = VBsprintf(sSQL, ioptActivo)
    
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
  lRegistros2 = ADORS.RecordCount
    
  If lRegistros2 <> 0 Then
    
    'Datos
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).NumberFormat = "@"
    xlSheet2.Range(xlSheet2.Cells(lFila2, 3), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).NumberFormat = "##,##0"
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).Font.Size = 8
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).HorizontalAlignment = xlLeft
    xlSheet2.Range(xlSheet2.Cells(lFila2, 3), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).HorizontalAlignment = xlRight
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).Borders.LineStyle = xlContinuous
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).Borders.Weight = 2
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 4)).Borders(xlEdgeTop).Weight = 3
    xlSheet2.Range(xlSheet2.Cells(lFila2 + lRegistros2 - 1, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).Borders(xlEdgeBottom).Weight = 3
    xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 1)).Borders(xlEdgeLeft).Weight = 3
    xlSheet2.Range(xlSheet2.Cells(lFila2, 2), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).Borders(xlEdgeRight).Weight = 3
  
    For l = 1 To lRegistros2
    
      xlSheet2.Cells(lFila2, 1) = LeerCampo(ADORS!sPremDesc)
      xlSheet2.Cells(lFila2, 2) = LeerCampo(ADORS!sPremCome)
      xlSheet2.Cells(lFila2, 3) = Format(LeerCampo(ADORS!nPremStoc), "##,##0")
      xlSheet2.Cells(lFila2, 4) = Format(LeerCampo(ADORS!nTickCant), "##,##0")
      
      ADORS.MoveNext
        
      lFila2 = lFila2 + 1
    
    Next
    
  End If
  
  'Total
  xlSheet1.Cells(lFila1, 1).NumberFormat = "@"
  xlSheet1.Cells(lFila1, 1).Font.Bold = True
  xlSheet1.Cells(lFila1, 1).Font.Size = 8
  xlSheet1.Cells(lFila1, 1).HorizontalAlignment = xlLeft
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders.LineStyle = xlContinuous
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 2)).Borders.Weight = 3
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 3)).Merge
  
  xlSheet1.Cells(lFila1, 1) = "Total: " + Format(lRegistros1, "##,##0")
  
  xlSheet2.Cells(lFila2, 1).NumberFormat = "@"
  xlSheet2.Cells(lFila2, 1).Font.Bold = True
  xlSheet2.Cells(lFila2, 1).Font.Size = 8
  xlSheet2.Cells(lFila2, 1).HorizontalAlignment = xlLeft
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 2)).Borders.LineStyle = xlContinuous
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 2)).Borders.Weight = 3
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 3)).Merge
  
  xlSheet2.Cells(lFila2, 1) = "Total: " + Format(lRegistros2, "##,##0")
  
  lFila1 = lFila1 + 1
  lFila2 = lFila2 + 1
  
  ReportePremioDatos = True
    
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
  
End Function

Private Function ReporteUsuario() As Boolean

  'Genera Reporte Relacion de Usuarios
  
  On Error GoTo LineaError
  
  Dim xlApp As Excel.Application
  Dim xlBook As Excel.Workbook
  Dim xlSheet As Excel.Worksheet
  Dim xlSheetTemp As Excel.Worksheet
  
  Dim lFila As Long
  
  ReporteUsuario = False
  
  cmdMensaje.Visible = True
  
  Set xlApp = CreateObject("excel.application")
  Set xlBook = xlApp.Workbooks.Add
  Set xlSheet = xlBook.Worksheets.Add
  
  xlSheet.Name = "Usuarios"
  
  xlBook.Application.DisplayAlerts = False
  
  For Each xlSheetTemp In xlBook.Worksheets
    If xlSheetTemp.Name <> xlSheet.Name Then
      xlSheetTemp.Delete
    End If
  Next xlSheetTemp
  
  xlBook.Application.DisplayAlerts = True
  
  'Formato Página
  xlSheet.PageSetup.Orientation = xlPortrait
  xlSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.3)
  xlSheet.PageSetup.RightMargin = Application.InchesToPoints(0.3)
  xlSheet.PageSetup.TopMargin = Application.InchesToPoints(0.5)
  xlSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.5)
  xlSheet.PageSetup.HeaderMargin = Application.InchesToPoints(0.1)
  xlSheet.PageSetup.FooterMargin = Application.InchesToPoints(0.1)
  xlSheet.PageSetup.PrintTitleRows = xlSheet.Rows("1:4").Address
    
  'Cabecera / Pie de Página
  xlSheet.PageSetup.LeftHeader = "&6Moy Park"
  xlSheet.PageSetup.RightHeader = "&6" + "Sistema de Afiliación de Clientes"
  xlSheet.PageSetup.RightFooter = "&6página &P"
  
  'Columna
  xlSheet.Columns(1).ColumnWidth = 20
  xlSheet.Columns(2).ColumnWidth = 20
  xlSheet.Columns(3).ColumnWidth = 52
  
  lFila = 1
  
  'Título
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + 1, 1)).NumberFormat = "@"
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + 1, 1)).Font.Bold = True
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + 1, 1)).Font.Size = 11
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + 1, 1)).HorizontalAlignment = xlCenter
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Merge
  xlSheet.Range(xlSheet.Cells(lFila + 1, 1), xlSheet.Cells(lFila + 1, 3)).Merge
  
  If optActivo(kNO).Value Then
    xlSheet.Cells(lFila, 1).Value = "RELACION DE USUARIOS INACTIVOS"
  ElseIf optActivo(kSI).Value Then
    xlSheet.Cells(lFila, 1).Value = "RELACION DE USUARIOS ACTIVOS"
  Else
    xlSheet.Cells(lFila, 1).Value = "RELACION DE USUARIOS ACTIVOS E INACTIVOS"
  End If
  
  lFila = lFila + 3
   
  'SubTítulo
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).NumberFormat = "@"
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Font.Bold = True
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Font.Size = 8
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).HorizontalAlignment = xlCenter
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders.LineStyle = xlContinuous
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders.Weight = 2
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders(xlEdgeTop).Weight = 3
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders(xlEdgeBottom).Weight = 3
  xlSheet.Cells(lFila, 1).Borders(xlEdgeLeft).Weight = 3
  xlSheet.Cells(lFila, 3).Borders(xlEdgeRight).Weight = 3
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Interior.ColorIndex = 15
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Interior.Pattern = xlSolid
  
  xlSheet.Cells(lFila, 1).Value = "Usuario"
  xlSheet.Cells(lFila, 2).Value = "Perfil"
  xlSheet.Cells(lFila, 3).Value = "Nombre"
  
  lFila = lFila + 1
  
  If optActivo(kTODOS).Value Then
  
    lFila = lFila + 1
  
    xlSheet.Cells(lFila, 1).NumberFormat = "@"
    xlSheet.Cells(lFila, 1).Font.Bold = True
    xlSheet.Cells(lFila, 1).Font.Size = 8
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders.LineStyle = xlContinuous
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders.Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Merge
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Interior.ColorIndex = 15
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Interior.Pattern = xlSolid
    
    xlSheet.Cells(lFila, 1).Value = "USUARIOS ACTIVOS"
    
    lFila = lFila + 1
    
  End If
  
  If optActivo(kTODOS).Value Or optActivo(kSI).Value Then
    If Not ReporteUsuarioDatos(xlSheet, lFila, kSI) Then GoTo LineaError1
  End If
  
  If optActivo(kTODOS).Value Then
  
    lFila = lFila + 1
  
    xlSheet.Cells(lFila, 1).NumberFormat = "@"
    xlSheet.Cells(lFila, 1).Font.Bold = True
    xlSheet.Cells(lFila, 1).Font.Size = 8
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders.LineStyle = xlContinuous
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders.Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Merge
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Interior.ColorIndex = 15
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Interior.Pattern = xlSolid
    
    xlSheet.Cells(lFila, 1).Value = "USUARIOS INACTIVOS"
    
    lFila = lFila + 1
    
  End If
  
  If optActivo(kTODOS).Value Or optActivo(kNO).Value Then
    If Not ReporteUsuarioDatos(xlSheet, lFila, kNO) Then GoTo LineaError1
  End If
  
  'Mostrar
  xlApp.WindowState = xlMaximized
  xlApp.Visible = True
  
  ReporteUsuario = True
    
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
LineaError1:
  
  On Error Resume Next

  xlBook.Close False
  xlApp.Quit
  
Salir:

  On Error Resume Next
  
  Set xlSheetTemp = Nothing
  Set xlSheet = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing
  
  cmdMensaje.Visible = False
  
End Function

Private Function ReporteUsuarioDatos(xlSheet As Excel.Worksheet, lFila As Long, ioptActivo As Integer) As Boolean

  'Inserta la parte de datos en el reporte
  
  On Error GoTo LineaError
  
  Dim lRegistros As Long
  Dim l As Long
  
  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  ReporteUsuarioDatos = False
  
  sSQL = "SELECT a.*, b.sPerfDesc " + _
         "FROM Usuario a, Perfil b " + _
         "WHERE a.cPerfCode = b.cPerfCode AND " + _
         "cUserActi = $ " + _
         "ORDER BY sUserApel + ' ' + sUserName"
  sSQL = VBsprintf(sSQL, ioptActivo)
    
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir
    
  lRegistros = ADORS.RecordCount
    
  If lRegistros <> 0 Then
    
    'Datos
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 3)).NumberFormat = "@"
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 3)).Font.Size = 8
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 3)).HorizontalAlignment = xlLeft
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 3)).Borders.LineStyle = xlContinuous
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 3)).Borders.Weight = 2
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders(xlEdgeTop).Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila + lRegistros - 1, 1), xlSheet.Cells(lFila + lRegistros - 1, 3)).Borders(xlEdgeBottom).Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila + lRegistros - 1, 1)).Borders(xlEdgeLeft).Weight = 3
    xlSheet.Range(xlSheet.Cells(lFila, 3), xlSheet.Cells(lFila + lRegistros - 1, 3)).Borders(xlEdgeRight).Weight = 3
  
    For l = 1 To lRegistros
    
      xlSheet.Cells(lFila, 1) = LeerCampo(ADORS!sUserDesc)
      xlSheet.Cells(lFila, 2) = LeerCampo(ADORS!sPerfDesc)
      xlSheet.Cells(lFila, 3) = LeerCampo(ADORS!sUserApel) + " " + LeerCampo(ADORS!sUserName)
      
      ADORS.MoveNext
        
      lFila = lFila + 1
    
    Next
    
  End If
  
  'Total
  xlSheet.Cells(lFila, 1).NumberFormat = "@"
  xlSheet.Cells(lFila, 1).Font.Bold = True
  xlSheet.Cells(lFila, 1).Font.Size = 8
  xlSheet.Cells(lFila, 1).HorizontalAlignment = xlLeft
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders.LineStyle = xlContinuous
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Borders.Weight = 3
  xlSheet.Range(xlSheet.Cells(lFila, 1), xlSheet.Cells(lFila, 3)).Merge
  
  xlSheet.Cells(lFila, 1) = "Total: " + Format(lRegistros, "##,##0")
  
  lFila = lFila + 1
  
  ReporteUsuarioDatos = True
    
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
  
End Function


