VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MsComCtl.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSComCt2.ocx"
Begin VB.Form frmAcumulacionFecha 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Acumulación por Fecha"
   ClientHeight    =   8280
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10785
   Icon            =   "frmAcumulacionFecha.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   8280
   ScaleWidth      =   10785
   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            =   3120
      TabIndex        =   15
      Top             =   7800
      Visible         =   0   'False
      Width           =   4695
   End
   Begin VB.CommandButton cmdExcel 
      Caption         =   "&Editar en Excel"
      Height          =   375
      Left            =   7920
      TabIndex        =   11
      Top             =   7800
      Width           =   1335
   End
   Begin VB.CommandButton cmdCliente 
      Caption         =   "&Ver Cliente"
      Height          =   375
      Index           =   1
      Left            =   1560
      TabIndex        =   10
      Top             =   7800
      Width           =   1335
   End
   Begin VB.CommandButton cmdCliente 
      Caption         =   "&Ver Cliente"
      Height          =   375
      Index           =   0
      Left            =   1560
      TabIndex        =   7
      Top             =   3960
      Width           =   1335
   End
   Begin VB.CommandButton cmdSalir 
      Caption         =   "&Salir"
      Height          =   375
      Left            =   9360
      TabIndex        =   12
      Top             =   7800
      Width           =   1335
   End
   Begin VB.CommandButton cmdBuscar 
      Caption         =   "B&uscar"
      Default         =   -1  'True
      Height          =   375
      Left            =   4680
      TabIndex        =   4
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton cmdExtornar 
      Caption         =   "E&xtornar"
      Height          =   375
      Index           =   0
      Left            =   120
      TabIndex        =   6
      Top             =   3960
      Width           =   1335
   End
   Begin VB.CommandButton cmdExtornar 
      Caption         =   "Ext&ornar"
      Height          =   375
      Index           =   1
      Left            =   120
      TabIndex        =   9
      Top             =   7800
      Width           =   1335
   End
   Begin MSComctlLib.ListView lvwPunto 
      Height          =   3015
      Left            =   120
      TabIndex        =   5
      Top             =   840
      Width           =   10455
      _ExtentX        =   18441
      _ExtentY        =   5318
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      _Version        =   393217
      Icons           =   "imlAcumulacion"
      SmallIcons      =   "imlAcumulacion"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin MSComctlLib.ListView lvwTicket 
      Height          =   3015
      Left            =   120
      TabIndex        =   8
      Top             =   4680
      Width           =   10455
      _ExtentX        =   18441
      _ExtentY        =   5318
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      _Version        =   393217
      Icons           =   "imlAcumulacion"
      SmallIcons      =   "imlAcumulacion"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin MSComCtl2.DTPicker dtpFInicio 
      Height          =   315
      Left            =   960
      TabIndex        =   1
      Top             =   120
      Width           =   1215
      _ExtentX        =   2143
      _ExtentY        =   556
      _Version        =   393216
      CalendarForeColor=   -2147483640
      CalendarTitleBackColor=   -2147483645
      CalendarTitleForeColor=   -2147483629
      CalendarTrailingForeColor=   -2147483645
      CustomFormat    =   "dd/MM/yyyy"
      Format          =   58261507
      CurrentDate     =   37042
   End
   Begin MSComCtl2.DTPicker dtpFFin 
      Height          =   315
      Left            =   3240
      TabIndex        =   3
      Top             =   120
      Width           =   1215
      _ExtentX        =   2143
      _ExtentY        =   556
      _Version        =   393216
      CalendarForeColor=   -2147483640
      CalendarTitleBackColor=   -2147483645
      CalendarTitleForeColor=   -2147483629
      CalendarTrailingForeColor=   -2147483645
      CustomFormat    =   "dd/MM/yyyy"
      Format          =   58261507
      CurrentDate     =   37042
   End
   Begin MSComctlLib.ImageList imlAcumulacion 
      Left            =   0
      Top             =   -240
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmAcumulacionFecha.frx":0442
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmAcumulacionFecha.frx":0894
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmAcumulacionFecha.frx":0CE6
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Label lblLabels 
      Caption         =   "Del"
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   495
   End
   Begin VB.Label lblLabels 
      Caption         =   "Al"
      Height          =   255
      Index           =   1
      Left            =   2760
      TabIndex        =   2
      Top             =   240
      Width           =   495
   End
   Begin VB.Label lblLabels 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Puntos"
      Height          =   255
      Index           =   2
      Left            =   120
      TabIndex        =   14
      Top             =   600
      Width           =   10455
   End
   Begin VB.Label lblLabels 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Tickets"
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   13
      Top             =   4440
      Width           =   10455
   End
End
Attribute VB_Name = "frmAcumulacionFecha"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public dFInicio As Date
Public dFFin As Date

Private Sub Form_Activate()

  On Error GoTo LineaError
  
  'Form Actual
  psForm = kFORM_ACUMULACION_FECHA
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Private Sub Form_Load()

  'Carga el formulario
  
  On Error GoTo LineaError

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

Private Sub ConfigurarColumnas()

  'Configura las columnas de la lista lvwpunto
  
  On Error GoTo LineaError

  Dim aColumnTitle() As String
  Dim aColumnWidth() As Single
  Dim aColumnAlign() As Integer
  
  ReDim aColumnTitle(8) As String
  ReDim aColumnWidth(8) As Single
  ReDim aColumnAlign(8) As Integer

  aColumnTitle(0) = "Fecha Acum."
  aColumnTitle(1) = "Tarjeta"
  aColumnTitle(2) = "Cliente"
  aColumnTitle(3) = "Importe"
  aColumnTitle(4) = "Puntos"
  aColumnTitle(5) = "Usuario"
  aColumnTitle(6) = "Fecha Extorno"
  aColumnTitle(7) = "Usuario Extorno"
  
  aColumnWidth(0) = 0.11
  aColumnWidth(1) = 0.1
  aColumnWidth(2) = 0.2
  aColumnWidth(3) = 0.1
  aColumnWidth(4) = 0.1
  aColumnWidth(5) = 0.11
  aColumnWidth(6) = 0.11
  aColumnWidth(7) = 0.11
  
  aColumnAlign(0) = lvwColumnLeft
  aColumnAlign(1) = lvwColumnLeft
  aColumnAlign(2) = lvwColumnLeft
  aColumnAlign(3) = lvwColumnRight
  aColumnAlign(4) = lvwColumnRight
  aColumnAlign(5) = lvwColumnLeft
  aColumnAlign(6) = lvwColumnLeft
  aColumnAlign(7) = lvwColumnLeft
    
  Call oListAdmin.InicializarLista(lvwPunto, aColumnTitle, _
                                   aColumnWidth, aColumnAlign, lvwReport)
                                   
  ReDim aColumnTitle(7) As String
  ReDim aColumnWidth(7) As Single
  ReDim aColumnAlign(7) As Integer

  aColumnTitle(0) = "Fecha Acum."
  aColumnTitle(1) = "Tarjeta"
  aColumnTitle(2) = "Cliente"
  aColumnTitle(3) = "Tickets"
  aColumnTitle(4) = "Usuario"
  aColumnTitle(5) = "Fecha Extorno"
  aColumnTitle(6) = "Usuario Extorno"
  
  aColumnWidth(0) = 0.12
  aColumnWidth(1) = 0.1
  aColumnWidth(2) = 0.26
  aColumnWidth(3) = 0.1
  aColumnWidth(4) = 0.12
  aColumnWidth(5) = 0.12
  aColumnWidth(6) = 0.12
  
  aColumnAlign(0) = lvwColumnLeft
  aColumnAlign(1) = lvwColumnLeft
  aColumnAlign(2) = lvwColumnLeft
  aColumnAlign(3) = lvwColumnRight
  aColumnAlign(4) = lvwColumnLeft
  aColumnAlign(5) = lvwColumnLeft
  aColumnAlign(6) = lvwColumnLeft
    
  Call oListAdmin.InicializarLista(lvwTicket, aColumnTitle, _
                                   aColumnWidth, aColumnAlign, lvwReport)
                                   
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub InicializarForm()

  'Inicializa el Form
  
  On Error GoTo LineaError
  
  Call CentrarControl(Me, cmdMensaje)
  
  dtpFInicio.Value = Date - 15
  dtpFFin.Value = Date
  
  Call cmdBuscar_Click
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
End Sub

Public Sub cmdBuscar_Click()

  'Buscar Acumulacion según rango de fecha

  On Error GoTo LineaError

  lvwPunto.ListItems.Clear
  lvwTicket.ListItems.Clear

  LlenarListaAcumulacionPunto
  LlenarListaAcumulacionTicket
  
  dFInicio = dtpFInicio.Value
  dFFin = dtpFFin.Value

  ManejarControles

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Public Sub LlenarListaAcumulacionPunto()

  'Llena la lista Punto

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  Dim itemX As ListItem

  sSQL = "SELECT a.*, sClieApel, sClieName " + _
         "FROM Acumulacion_Punto a, Cliente b " + _
         "WHERE a.cClieCode = b.cClieCode AND " + _
         "FORMAT(dAcumDate, 'yyyy/mm/dd') >= '$' AND " + _
         "FORMAT(dAcumDate, 'yyyy/mm/dd') <= '$' " + _
         "Order by dAcumDate DESC, sClieApel + ' ' + sClieName"
  sSQL = VBsprintf(sSQL, Format(dtpFInicio.Value, "yyyy/mm/dd"), _
         Format(dtpFFin.Value, "yyyy/mm/dd"))
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir

  Do While Not ADORS.EOF

    Set itemX = lvwPunto.ListItems.Add(, "k" + RPad(LeerCampo(ADORS!cClieCode), 10, " ") + LeerCampo(ADORS!cAcumCode), Format(LeerCampo(ADORS!dAcumDate), "dd/mm/yyyy hh:mm"))
    itemX.SubItems(1) = LeerCampo(ADORS!nTarjNumb)
    itemX.SubItems(2) = LeerCampo(ADORS!sClieApel) + " " + LeerCampo(ADORS!sClieName)
    itemX.SubItems(3) = LeerCampo(ADORS!nAcumImpo)
    itemX.SubItems(4) = LeerCampo(ADORS!nPuntCant)
    itemX.SubItems(5) = LeerCampo(ADORS!sUserDesc)

    If LeerCampo(ADORS!dExtoDate) = "" Then
      
      If LeerCampo(ADORS!cAjusFlag) <> CStr(kSI) Then
        
        itemX.Icon = 1
        itemX.SmallIcon = 1
        
      Else
      
        itemX.Icon = 3
        itemX.SmallIcon = 3
      
      End If
      
    Else
      itemX.SubItems(6) = Format(LeerCampo(ADORS!dExtoDate), "dd/mm/yyyy hh:mm")
      itemX.SubItems(7) = LeerCampo(ADORS!sUseEDesc)
      itemX.Icon = 2
      itemX.SmallIcon = 2
    End If

    ADORS.MoveNext

  Loop

  lblLabels(2).Caption = "Puntos   -   Del " + Format(dtpFInicio.Value, "dd/mm/yyyy") + " Al " + Format(dtpFFin.Value, "dd/mm/yyyy")
  
  GoTo Salir

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing
  
End Sub

Public Sub LlenarListaAcumulacionTicket()

  'Llena la lista Ticket

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset

  Dim itemX As ListItem

  sSQL = "SELECT a.*, sClieApel, sClieName " + _
         "FROM Acumulacion_Ticket a, Cliente b " + _
         "WHERE a.cClieCode = b.cClieCode AND " + _
         "FORMAT(dAcumDate, 'yyyy/mm/dd') >= '$' AND " + _
         "FORMAT(dAcumDate, 'yyyy/mm/dd') <= '$' " + _
         "Order by dAcumDate DESC, sClieApel + ' ' + sClieName"
  sSQL = VBsprintf(sSQL, Format(dtpFInicio.Value, "yyyy/mm/dd"), _
         Format(dtpFFin.Value, "yyyy/mm/dd"))
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo Salir

  Do While Not ADORS.EOF

    Set itemX = lvwTicket.ListItems.Add(, "k" + RPad(LeerCampo(ADORS!cClieCode), 10, " ") + LeerCampo(ADORS!cAcumCode), Format(LeerCampo(ADORS!dAcumDate), "dd/mm/yyyy hh:mm"))
    itemX.SubItems(1) = LeerCampo(ADORS!nTarjNumb)
    itemX.SubItems(2) = LeerCampo(ADORS!sClieApel) + " " + LeerCampo(ADORS!sClieName)
    itemX.SubItems(3) = LeerCampo(ADORS!nTickCant)
    itemX.SubItems(4) = LeerCampo(ADORS!sUserDesc)

    If LeerCampo(ADORS!dExtoDate) = "" Then
      
      If LeerCampo(ADORS!cAjusFlag) <> CStr(kSI) Then
        
        itemX.Icon = 1
        itemX.SmallIcon = 1
        
      Else
      
        itemX.Icon = 3
        itemX.SmallIcon = 3
      
      End If
      
    Else
      itemX.SubItems(5) = Format(LeerCampo(ADORS!dExtoDate), "dd/mm/yyyy hh:mm")
      itemX.SubItems(6) = LeerCampo(ADORS!sUseEDesc)
      itemX.Icon = 2
      itemX.SmallIcon = 2
    End If

    ADORS.MoveNext

  Loop

  lblLabels(3).Caption = "Tickets   -   Del " + Format(dtpFInicio.Value, "dd/mm/yyyy") + " Al " + Format(dtpFFin.Value, "dd/mm/yyyy")
  
  GoTo Salir

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
Salir:
  Set ADORS = Nothing

End Sub

Public Sub ManejarControles()

  'Maneja el uso de los controles

  On Error GoTo LineaError

  Call DeshabilitarControl(cmdCliente(kPUNTO), False)
  Call DeshabilitarControl(cmdCliente(kTICKET), False)
  Call DeshabilitarControl(cmdExtornar(kPUNTO), False)
  Call DeshabilitarControl(cmdExtornar(kTICKET), False)
  
  Call DeshabilitarControl(cmdExcel, False)
  
   If lvwPunto.ListItems.Count > 0 Then
   
    lvwPunto.SelectedItem.EnsureVisible
    
    Call HabilitarControl(cmdCliente(kPUNTO), False)
    
    If piPerfil_Codigo = kPERFIL_ADMINISTRADOR Or piPerfil_Codigo = kPERFIL_SUPERVISOR Then
      Call HabilitarControl(cmdExtornar(kPUNTO), False)
    End If
    
  End If

  If lvwTicket.ListItems.Count > 0 Then
    lvwTicket.SelectedItem.EnsureVisible
    
    Call HabilitarControl(cmdCliente(kTICKET), False)
    
    If piPerfil_Codigo = kPERFIL_ADMINISTRADOR Or piPerfil_Codigo = kPERFIL_SUPERVISOR Then
      Call HabilitarControl(cmdExtornar(kTICKET), False)
    End If
    
  End If
  
  If (lvwPunto.ListItems.Count > 0 Or lvwTicket.ListItems.Count > 0) And _
  (piPerfil_Codigo = kPERFIL_ADMINISTRADOR Or piPerfil_Codigo = kPERFIL_SUPERVISOR) Then
    Call HabilitarControl(cmdExcel, False)
  End If
  
  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwPunto_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'Ordenar Según la columna seleccionada

  On Error GoTo LineaError

  If ColumnHeader.Index = 1 Or ColumnHeader.Index = 7 Then

    Call APISort(lvwPunto, ColumnHeader.Index, _
                 gbytLVW_SORT_DATE)

  ElseIf ColumnHeader.Index = 4 Or ColumnHeader.Index = 5 Then

    Call APISort(lvwPunto, ColumnHeader.Index, _
                 gbytLVW_SORT_VALUE)

  Else

    Call APISort(lvwPunto, ColumnHeader.Index, _
                 gbytLVW_SORT_DEFAULT)

  End If

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub lvwTicket_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

  'Ordenar Según la columna seleccionada

  On Error GoTo LineaError

  If ColumnHeader.Index = 1 Or ColumnHeader.Index = 6 Then

    Call APISort(lvwTicket, ColumnHeader.Index, _
                 gbytLVW_SORT_DATE)

  ElseIf ColumnHeader.Index = 4 Then

    Call APISort(lvwTicket, ColumnHeader.Index, _
                 gbytLVW_SORT_VALUE)

  Else

    Call APISort(lvwTicket, ColumnHeader.Index, _
                 gbytLVW_SORT_DEFAULT)

  End If

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub cmdExtornar_Click(Index As Integer)

  'Extornar

  On Error GoTo LineaError

  If Index = kPUNTO Then
    ExtornarPunto
  Else
    ExtornarTicket
  End If

  Screen.MousePointer = vbDefault

  Exit Sub

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

End Sub

Private Sub ExtornarPunto()

  'Extornar Acumulacion de Puntos

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim sCliente As String
  Dim sAcumulacion As String

  Dim itemX As ListItem
  Dim bConnFlag As Boolean

  Dim lPunto As Long
  Dim lCantidad As Long

  Screen.MousePointer = vbHourglass

  If lvwPunto.SelectedItem.SmallIcon = 2 Then
    MsgBox "Transacción ya ha sido extornada", vbOKOnly + vbInformation
    Exit Sub
  ElseIf lvwPunto.SelectedItem.SmallIcon = 3 Then
    MsgBox "Los ajustes no pueden ser extornados", vbOKOnly + vbInformation
    Exit Sub
  End If
  
  sCliente = Mid(lvwPunto.SelectedItem.Key, 2, 10)
  sAcumulacion = Mid(lvwPunto.SelectedItem.Key, 12)
  
  sSQL = "SELECT nPuntCant FROM Cliente WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, sCliente)
  
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo LineaError1
  
  lPunto = LeerCampo(ADORS!nPuntCant)
  lCantidad = CLng(lvwPunto.SelectedItem.SubItems(4))
  
  Set ADORS = Nothing

  If lPunto < lCantidad Then
    MsgBox "No se puede ejecutar el proceso. Puntos acumulados actualmente menor a la cantidad a extornar.", vbOKOnly + vbInformation
    Exit Sub
  End If

  If MsgBox("Se extornará transacción seleccionada (Fecha: " + lvwPunto.SelectedItem.Text + " - Cliente: " + lvwPunto.SelectedItem.SubItems(2) + " - Cantidad: " + lvwPunto.SelectedItem.SubItems(4) + "). Confirma Acción?", _
  vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

  ADOCnn.BeginTrans
  bConnFlag = True

  sSQL = "UPDATE Acumulacion_Punto SET dExtoDate = '$', sUseEDesc = '$' " + _
         "WHERE cClieCode = $ AND cAcumCode = $"
  sSQL = VBsprintf(sSQL, Format(Now, "yyyy/mm/dd hh:mm"), ReemplazarComilla(psUsuario_Descripcion), sCliente, _
         sAcumulacion)

  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

  sSQL = "UPDATE Cliente SET nPuntCant = nPuntCant - $ " + _
         "WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, lCantidad, _
         sCliente)

  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

  ADOCnn.CommitTrans
  bConnFlag = False

  Set itemX = lvwPunto.SelectedItem

  itemX.SubItems(6) = Format(Now, "dd/mm/yyyy hh:mm")
  itemX.SubItems(7) = psUsuario_Descripcion
  itemX.Icon = 2
  itemX.SmallIcon = 2

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

LineaError1:
  Set ADORS = Nothing
  If bConnFlag Then ADOCnn.RollbackTrans

End Sub

Private Sub ExtornarTicket()

  'Extornar Acumulacion de Tickets

  On Error GoTo LineaError

  Dim sSQL As String
  Dim ADORS As ADODB.Recordset
  
  Dim sCliente As String
  Dim sAcumulacion As String

  Dim itemX As ListItem
  Dim bConnFlag As Boolean

  Dim lTicket As Long
  Dim lCantidad As Long

  Screen.MousePointer = vbHourglass

  If lvwTicket.SelectedItem.SmallIcon = 2 Then
    MsgBox "Transacción ya ha sido extornada", vbOKOnly + vbInformation
    Exit Sub
  ElseIf lvwTicket.SelectedItem.SmallIcon = 3 Then
    MsgBox "Los ajustes no pueden ser extornados", vbOKOnly + vbInformation
    Exit Sub
  End If
  
  sCliente = Mid(lvwTicket.SelectedItem.Key, 2, 10)
  sAcumulacion = Mid(lvwTicket.SelectedItem.Key, 12)
  
  sSQL = "SELECT nTickCant FROM Cliente WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, sCliente)
  
  If Not oDBAdmin.EjecutarConsulta(ADOCnn, sSQL, ADORS) Then GoTo LineaError1
  
  lTicket = LeerCampo(ADORS!nTickCant)
  lCantidad = CLng(lvwTicket.SelectedItem.SubItems(3))
  
  Set ADORS = Nothing

  If lTicket < lCantidad Then
    MsgBox "No se puede ejecutar el proceso. Tickets acumulados actualmente menor a la cantidad a extornar.", vbOKOnly + vbInformation
    Exit Sub
  End If

  If MsgBox("Se extornará transacción seleccionada (Fecha: " + lvwTicket.SelectedItem.Text + " - Cliente: " + lvwTicket.SelectedItem.SubItems(2) + " - Cantidad: " + lvwTicket.SelectedItem.SubItems(3) + "). Confirma Acción?", _
  vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

  ADOCnn.BeginTrans
  bConnFlag = True

  sSQL = "UPDATE Acumulacion_Ticket SET dExtoDate = '$', sUseEDesc = '$' " + _
         "WHERE cClieCode = $ AND cAcumCode = $"
  sSQL = VBsprintf(sSQL, Format(Now, "yyyy/mm/dd hh:mm"), ReemplazarComilla(psUsuario_Descripcion), sCliente, _
         sAcumulacion)

  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

  sSQL = "UPDATE Cliente SET nTickCant = nTickCant - $ " + _
         "WHERE cClieCode = $"
  sSQL = VBsprintf(sSQL, lCantidad, _
         sCliente)

  If Not oDBAdmin.EjecutarSentencia(ADOCnn, sSQL) Then GoTo LineaError1

  ADOCnn.CommitTrans
  bConnFlag = False

  Set itemX = lvwTicket.SelectedItem

  itemX.SubItems(5) = Format(Now, "dd/mm/yyyy hh:mm")
  itemX.SubItems(6) = psUsuario_Descripcion
  itemX.Icon = 2
  itemX.SmallIcon = 2

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

LineaError1:
  Set ADORS = Nothing
  If bConnFlag Then ADOCnn.RollbackTrans

End Sub

Private Sub cmdCliente_Click(Index As Integer)

  'Invoca al formulario Usuario
  
  On Error GoTo LineaError
  
  psLista = Index
  frmCliente.iEditar = kCMD_VER
  frmCliente.Show vbModal
  
  Exit Sub
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub

Private Sub CmdExcel_Click()

  'Editar en Hoja Excel

  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
  Dim i As Long
  Dim lRegistros1 As Long
  Dim lRegistros2 As Long
  
  Screen.MousePointer = vbHourglass
   
  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 = xlLandscape
  xlSheet1.PageSetup.LeftMargin = Application.InchesToPoints(0.5)
  xlSheet1.PageSetup.RightMargin = Application.InchesToPoints(0.5)
  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:5").Address
  
  xlSheet2.PageSetup.Orientation = xlLandscape
  xlSheet2.PageSetup.LeftMargin = Application.InchesToPoints(0.5)
  xlSheet2.PageSetup.RightMargin = Application.InchesToPoints(0.5)
  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:5").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 = 13
  xlSheet1.Columns(2).ColumnWidth = 8.5
  xlSheet1.Columns(3).ColumnWidth = 36
  xlSheet1.Columns(4).ColumnWidth = 9.5
  xlSheet1.Columns(5).ColumnWidth = 9.5
  xlSheet1.Columns(6).ColumnWidth = 12
  xlSheet1.Columns(7).ColumnWidth = 13
  xlSheet1.Columns(8).ColumnWidth = 12
  xlSheet1.Columns(9).ColumnWidth = 15
  
  xlSheet2.Columns(1).ColumnWidth = 13
  xlSheet2.Columns(2).ColumnWidth = 10.5
  xlSheet2.Columns(3).ColumnWidth = 46.5
  xlSheet2.Columns(4).ColumnWidth = 8.5
  xlSheet2.Columns(5).ColumnWidth = 12
  xlSheet2.Columns(6).ColumnWidth = 13
  xlSheet2.Columns(7).ColumnWidth = 12
  xlSheet2.Columns(8).ColumnWidth = 15
  
  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, 9)).Merge
  xlSheet1.Range(xlSheet1.Cells(lFila1 + 1, 1), xlSheet1.Cells(lFila1 + 1, 9)).Merge
  
  xlSheet1.Cells(lFila1, 1).Value = "ACUMULACION DE PUNTOS"
  xlSheet1.Cells(lFila1 + 1, 1).Value = "DEL " + Format(dFInicio, "dd/mm/yyyy") + " AL " + Format(dFFin, "dd/mm/yyyy")
  
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + 1, 1)).NumberFormat = "@"
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + 1, 1)).Font.Bold = True
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + 1, 1)).Font.Size = 11
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + 1, 1)).HorizontalAlignment = xlCenter
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Merge
  xlSheet2.Range(xlSheet2.Cells(lFila2 + 1, 1), xlSheet2.Cells(lFila2 + 1, 8)).Merge
  
  xlSheet2.Cells(lFila2, 1).Value = "ACUMULACION DE TICKETS"
  xlSheet2.Cells(lFila2 + 1, 1).Value = "DEL " + Format(dFInicio, "dd/mm/yyyy") + " AL " + Format(dFFin, "dd/mm/yyyy")
  
  lFila1 = lFila1 + 4
  lFila2 = lFila2 + 4
   
  'SubTítulo
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).NumberFormat = "@"
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Font.Bold = True
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Font.Size = 8
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).HorizontalAlignment = xlCenter
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Borders.LineStyle = xlContinuous
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Borders.Weight = 2
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Borders(xlEdgeTop).Weight = 3
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Borders(xlEdgeBottom).Weight = 3
  xlSheet1.Cells(lFila1, 1).Borders(xlEdgeLeft).Weight = 3
  xlSheet1.Cells(lFila1, 9).Borders(xlEdgeRight).Weight = 3
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Interior.ColorIndex = 15
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Interior.Pattern = xlSolid
  
  xlSheet1.Cells(lFila1, 1).Value = "Fecha Acumulac."
  xlSheet1.Cells(lFila1, 2).Value = "Tarjeta"
  xlSheet1.Cells(lFila1, 3).Value = "Cliente"
  xlSheet1.Cells(lFila1, 4).Value = "Importe"
  xlSheet1.Cells(lFila1, 5).Value = "Puntos"
  xlSheet1.Cells(lFila1, 6).Value = "Usuario"
  xlSheet1.Cells(lFila1, 7).Value = "Fecha Extorno"
  xlSheet1.Cells(lFila1, 8).Value = "Usuar.Extor."
  xlSheet1.Cells(lFila1, 9).Value = "Tipo"
  
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).NumberFormat = "@"
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Font.Bold = True
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Font.Size = 8
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).HorizontalAlignment = xlCenter
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Borders.LineStyle = xlContinuous
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Borders.Weight = 2
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Borders(xlEdgeTop).Weight = 3
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Borders(xlEdgeBottom).Weight = 3
  xlSheet2.Cells(lFila2, 1).Borders(xlEdgeLeft).Weight = 3
  xlSheet2.Cells(lFila2, 8).Borders(xlEdgeRight).Weight = 3
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Interior.ColorIndex = 15
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Interior.Pattern = xlSolid
  
  xlSheet2.Cells(lFila2, 1).Value = "Fecha Acumulac."
  xlSheet2.Cells(lFila2, 2).Value = "Tarjeta"
  xlSheet2.Cells(lFila2, 3).Value = "Cliente"
  xlSheet2.Cells(lFila2, 4).Value = "Tickets"
  xlSheet2.Cells(lFila2, 5).Value = "Usuario"
  xlSheet2.Cells(lFila2, 6).Value = "Fecha Extorno"
  xlSheet2.Cells(lFila2, 7).Value = "Usuar.Extor."
  xlSheet2.Cells(lFila2, 8).Value = "Tipo"
  
  lFila1 = lFila1 + 1
  lFila2 = lFila2 + 1
  
  lRegistros1 = lvwPunto.ListItems.Count
  lRegistros2 = lvwTicket.ListItems.Count

  'Datos
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 9)).NumberFormat = "@"
  xlSheet1.Range(xlSheet1.Cells(lFila1, 4), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 5)).NumberFormat = "##,##0"
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 9)).Font.Size = 8
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 9)).HorizontalAlignment = xlLeft
  xlSheet1.Range(xlSheet1.Cells(lFila1, 4), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 5)).HorizontalAlignment = xlRight
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 9)).Borders.LineStyle = xlContinuous
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 9)).Borders.Weight = 2
  xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Borders(xlEdgeTop).Weight = 3
  xlSheet1.Range(xlSheet1.Cells(lFila1 + lRegistros1 - 1, 1), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 9)).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, 9), xlSheet1.Cells(lFila1 + lRegistros1 - 1, 9)).Borders(xlEdgeRight).Weight = 3

  For i = 1 To lRegistros1

    xlSheet1.Cells(lFila1, 1) = lvwPunto.ListItems(i).Text
    xlSheet1.Cells(lFila1, 2) = lvwPunto.ListItems(i).SubItems(1)
    xlSheet1.Cells(lFila1, 3) = lvwPunto.ListItems(i).SubItems(2)
    xlSheet1.Cells(lFila1, 4) = lvwPunto.ListItems(i).SubItems(3)
    xlSheet1.Cells(lFila1, 5) = lvwPunto.ListItems(i).SubItems(4)
    xlSheet1.Cells(lFila1, 6) = lvwPunto.ListItems(i).SubItems(5)
    xlSheet1.Cells(lFila1, 7) = lvwPunto.ListItems(i).SubItems(6)
    xlSheet1.Cells(lFila1, 8) = lvwPunto.ListItems(i).SubItems(7)
    
    If lvwPunto.ListItems(i).Icon = 1 Then
      xlSheet1.Cells(lFila1, 9) = "ACUMULACION"
    ElseIf lvwPunto.ListItems(i).Icon = 2 Then
      xlSheet1.Cells(lFila1, 9) = "ACUM.EXTORNADA"
      xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Font.ColorIndex = 53
    Else
      xlSheet1.Cells(lFila1, 9) = "AJUSTE"
      xlSheet1.Range(xlSheet1.Cells(lFila1, 1), xlSheet1.Cells(lFila1, 9)).Font.ColorIndex = 11
    End If

    lFila1 = lFila1 + 1

  Next
  
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 8)).NumberFormat = "@"
  xlSheet2.Range(xlSheet2.Cells(lFila2, 4), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).NumberFormat = "##,##0"
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 8)).Font.Size = 8
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 8)).HorizontalAlignment = xlLeft
  xlSheet2.Range(xlSheet2.Cells(lFila2, 4), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 4)).HorizontalAlignment = xlRight
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 8)).Borders.LineStyle = xlContinuous
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 8)).Borders.Weight = 2
  xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Borders(xlEdgeTop).Weight = 3
  xlSheet2.Range(xlSheet2.Cells(lFila2 + lRegistros2 - 1, 1), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 8)).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, 8), xlSheet2.Cells(lFila2 + lRegistros2 - 1, 8)).Borders(xlEdgeRight).Weight = 3

  For i = 1 To lRegistros2

    xlSheet2.Cells(lFila2, 1) = lvwTicket.ListItems(i).Text
    xlSheet2.Cells(lFila2, 2) = lvwTicket.ListItems(i).SubItems(1)
    xlSheet2.Cells(lFila2, 3) = lvwTicket.ListItems(i).SubItems(2)
    xlSheet2.Cells(lFila2, 4) = lvwTicket.ListItems(i).SubItems(3)
    xlSheet2.Cells(lFila2, 5) = lvwTicket.ListItems(i).SubItems(4)
    xlSheet2.Cells(lFila2, 6) = lvwTicket.ListItems(i).SubItems(5)
    xlSheet2.Cells(lFila2, 7) = lvwTicket.ListItems(i).SubItems(6)
    
    If lvwTicket.ListItems(i).Icon = 1 Then
      xlSheet2.Cells(lFila2, 8) = "ACUMULACION"
    ElseIf lvwTicket.ListItems(i).Icon = 2 Then
      xlSheet2.Cells(lFila2, 8) = "ACUM.EXTORNADA"
      xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Font.ColorIndex = 53
    Else
      xlSheet2.Cells(lFila2, 8) = "AJUSTE"
      xlSheet2.Range(xlSheet2.Cells(lFila2, 1), xlSheet2.Cells(lFila2, 8)).Font.ColorIndex = 11
    End If

    lFila2 = lFila2 + 1

  Next
  
  'Mostrar
  xlApp.WindowState = xlMaximized
  xlApp.Visible = True
    
  GoTo Salir
  
LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation
  
  On Error Resume Next

  xlBook.Close False
  xlApp.Quit
  
Salir:

  On Error Resume Next
  
  Set xlSheetTemp = Nothing
  Set xlSheet1 = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing
  
  cmdMensaje.Visible = False
  
  Screen.MousePointer = vbDefault

End Sub

Private Sub CmdSalir_Click()

  'Descargar Form

  On Error GoTo LineaError

  Unload Me

  Exit Sub

LineaError:
  MsgBox Err.Description, vbOKOnly + vbInformation

End Sub
