VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FCierreMes 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Cierre de Mes - Transferencia de Saldos (95.120.00)"
   ClientHeight    =   3435
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7125
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   3435
   ScaleWidth      =   7125
   Begin VB.CommandButton cmdBusAlmacen 
      Height          =   375
      Left            =   4230
      MouseIcon       =   "9512000.frx":0000
      MousePointer    =   99  'Custom
      Picture         =   "9512000.frx":0152
      Style           =   1  'Graphical
      TabIndex        =   6
      ToolTipText     =   "Buscar Almacén"
      Top             =   1230
      Width           =   375
   End
   Begin VB.ComboBox cmbMes 
      Height          =   315
      ItemData        =   "9512000.frx":0684
      Left            =   1005
      List            =   "9512000.frx":06AC
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   1620
      Width           =   1365
   End
   Begin MSComCtl2.Animation Animation1 
      Height          =   870
      Left            =   180
      TabIndex        =   3
      Top             =   2250
      Visible         =   0   'False
      Width           =   3570
      _ExtentX        =   6297
      _ExtentY        =   1535
      _Version        =   393216
      FullWidth       =   238
      FullHeight      =   58
   End
   Begin VB.CommandButton cmdCancelar 
      Caption         =   "&Cancelar"
      Height          =   735
      Left            =   5355
      Picture         =   "9512000.frx":0714
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   2400
      Width           =   1455
   End
   Begin VB.CommandButton cmdEjecutar 
      Caption         =   "&Ejecutar"
      Height          =   735
      Left            =   3915
      Picture         =   "9512000.frx":0A1E
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   2400
      Width           =   1455
   End
   Begin MSComCtl2.DTPicker dtpAnio 
      Height          =   330
      Left            =   3105
      TabIndex        =   4
      Top             =   1635
      Width           =   1050
      _ExtentX        =   1852
      _ExtentY        =   582
      _Version        =   393216
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      CustomFormat    =   "yyyy"
      Format          =   60817411
      UpDown          =   -1  'True
      CurrentDate     =   39477
   End
   Begin MSDataListLib.DataCombo dtcAlmacen 
      Height          =   315
      Left            =   990
      TabIndex        =   7
      Top             =   1230
      Width           =   3180
      _ExtentX        =   5609
      _ExtentY        =   556
      _Version        =   393216
      Style           =   2
      Text            =   ""
   End
   Begin VB.Label Label2 
      Caption         =   "Ultimo Cierre"
      Height          =   225
      Left            =   5700
      TabIndex        =   13
      Top             =   1050
      Width           =   975
   End
   Begin VB.Label lblCierre 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   5610
      TabIndex        =   12
      Top             =   1260
      Width           =   1185
   End
   Begin VB.Label lblAlmacen 
      AutoSize        =   -1  'True
      Caption         =   "Almacen"
      Height          =   195
      Left            =   240
      TabIndex        =   11
      Top             =   1275
      Width           =   615
   End
   Begin VB.Label lblMes 
      Caption         =   "Mes"
      Height          =   240
      Left            =   240
      TabIndex        =   10
      Top             =   1665
      Width           =   780
   End
   Begin VB.Label lblAnio 
      Caption         =   "Año"
      Height          =   285
      Left            =   2550
      TabIndex        =   9
      Top             =   1680
      Width           =   465
   End
   Begin VB.Label lblMensaje 
      ForeColor       =   &H00800000&
      Height          =   465
      Left            =   4350
      TabIndex        =   8
      Top             =   1740
      Width           =   2460
   End
   Begin VB.Shape Shape1 
      Height          =   3240
      Left            =   90
      Top             =   90
      Width           =   6945
   End
   Begin VB.Label Label1 
      Caption         =   $"9512000.frx":0D28
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   915
      Left            =   900
      TabIndex        =   2
      Top             =   180
      Width           =   6045
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   225
      Picture         =   "9512000.frx":0E34
      Top             =   225
      Width           =   480
   End
End
Attribute VB_Name = "FCierreMes"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' EDGAR MARTIN CANCHO RUIZ
' CIERRE DE MES DE INVENTARIO

Option Explicit
Public pb_editar As Boolean
Public pb_agregar As Boolean
Public pb_primerregistro As Boolean
Public pb_ultimoregistro As Boolean
Public pbderecho_agregar As Boolean
Public pbderecho_consultar As Boolean
Public pbderecho_editar As Boolean
Public pbderecho_borrar As Boolean
Public pbderecho_imprimir As Boolean
Public pbderecho_anular As Boolean
Public pbderecho_emitir As Boolean
Public pb_tiposcreen As String
 
Public GrecibeUbicacion As BookmarkEnum
Public GrecibeColumnaID As String
Public GrecibeColumnaOpcional As String

Private objAlmacen As DB_INV_MANTENIMIENTOS.C_ALMACEN
Private objCorrelativo As DB_CORRELATIVO.C_Correlativos
Private objProceso As DB_UT_MANTENIMIENTOS.C_PROCESOS
Private objSetup As UTIL_SETUP.C_SETUP


Dim lngCorrelativo As Long

Dim strDiaInicio As String
Dim strDiaFin As String
Dim strMes As String
Dim strMesH As String
Dim strAnio As String

Dim strUltimoCierre As String

Dim strCat As String
Dim strMonedaExtranjera As String


Private Sub cmdEjecutar_Click()
On Error GoTo trataerror

    ' Hay que verificar que se cerraron todos los Parte diarios
       
      Dim LobjUtil As UTIL_SETUP.C_SETUP
      Dim LrspDiario As ADODB.Recordset
      Dim LstrMensaje As String
      
      Set LobjUtil = New UTIL_SETUP.C_SETUP
      Set LrspDiario = New ADODB.Recordset
      
      
      Set LrspDiario = LobjUtil.Auxiliar3("UT_VerificarPdiario_Proc " & cmbMes.ListIndex + 1 & "," & Format(dtpAnio.Value, "YYYY") & ",'" & GstrSiteProce & "'")
              
      If Not LrspDiario.EOF Then
         LrspDiario.MoveFirst
         LstrMensaje = "No se han Cerrado los siguientes Partes Diarios : " & vbCrLf
         
         Do While Not LrspDiario.EOF
            LstrMensaje = LstrMensaje & LrspDiario!fecha & vbCrLf
            LrspDiario.MoveNext
         Loop
         
         MsgBox LstrMensaje + vbCrLf + vbCrLf + "********** NO PUEDE CERRAR EL MES ***********", vbDefaultButton1 + vbInformation, "Mensaje"
         Set LobjUtil = Nothing
         Exit Sub
      End If
                    
      Set LobjUtil = Nothing
       

    ' Fin de Verificar que se cerraron todos los Parte diarios



    Screen.MousePointer = 11
    'Image1.Visible = False
      
    lngCorrelativo = objCorrelativo.ObtenerCorrelativo(GCUSERID)
    strDiaInicio = "01"
    strDiaFin = numdias(cmbMes.ListIndex + 1, Year(dtpAnio.Value))
    If cmbMes.ListIndex < 9 Then
        strMes = "0" + CStr(cmbMes.ListIndex + 1)
        strMesH = "0" + CStr(cmbMes.ListIndex)
    Else
        strMes = CStr(cmbMes.ListIndex + 1)
        strMesH = Right("0" + CStr(cmbMes.ListIndex), 2)
    End If
    strAnio = CStr(dtpAnio.Year)
    strCat = "''" 'Si alguna vez se
    
    If ValidaCierre = 0 Then
        MsgBox "Ya ha sido realizado el Cierre de Mes de " & cmbMes.Text & " del " & dtpAnio.Year, vbExclamation, "Imposible realizar Cierre de Mes"
        Screen.MousePointer = 0
        Exit Sub
    Else
        If ValidaCierre = 2 Then
            MsgBox "Debe Procesar antes los meses anterioes", vbExclamation, "Imposible realizar Cierre de Mes"
            Screen.MousePointer = 0
            Exit Sub
        End If
    End If
    
    Animation1.Open GstrReportesVta & "Proceso.avi"
    Animation1.Visible = True
    Animation1.Play
    lblMensaje.Caption = "Transfiriendo Saldos en Moneda Base"
    lblMensaje.Refresh
    'objProceso
    objProceso.Cierre_de_Mes lngCorrelativo, GstrCodMonedaBase, strDiaInicio, strDiaFin, strMes, _
                                    strMesH, strAnio, DtcAlmacen.BoundText, strCat, 0, 1
    
    lblMensaje.Caption = "Transfiriendo Saldos en Moneda Extranjera"
    lblMensaje.Refresh
    
    objProceso.Cierre_de_Mes lngCorrelativo, strMonedaExtranjera, strDiaInicio, strDiaFin, strMes, _
                                    strMesH, strAnio, DtcAlmacen.BoundText, strCat, 0, 1

    Animation1.AutoPlay = False
    Animation1.Stop
    Animation1.Visible = False
    Screen.MousePointer = 0
    Me.Hide
    MsgBox "Proceso de Cierre realizado con éxito", vbInformation, "Cierre de Mes"
    Unload Me
    Exit Sub
    
trataerror:
    Screen.MousePointer = 0
    Me.Hide
    MsgBox MensajedeError(Err.Number, Err.Description), vbDefaultButton1 + vbCritical, "No se puede realizar cierre de mes"
    If Err.Number = 20000 Then
        MsgBox "Ejecute el Cálculo de Costo Promedio, verifique los saldos finales mediante su Kardex e intente realizar el cierre de mes," & Chr(13) & "es posible que haya ingresado alguna compra o alguna Nota de Crédito despues del último cálculo" & Chr(13) & "de costo promedio. ", vbExclamation, "Sugerencia"
    End If
    Unload Me
End Sub

Private Sub cmdBusAlmacen_Click()
    'Lineas que llaman al Formulario de Búsqueda
    
    Dim ArrayBusqueda(1 To 2, 1 To 3) As Variant
    ArrayBusqueda(1, 1) = "Siteid"
    ArrayBusqueda(1, 2) = "Código "
    ArrayBusqueda(1, 3) = 1000
    ArrayBusqueda(2, 1) = "Name"
    ArrayBusqueda(2, 2) = "Descripción "
    ArrayBusqueda(2, 3) = 4000
      
    FBusquedasUt.GObtenerRegistros objAlmacen.ListarAlmacenesPorStatus(1), ArrayBusqueda, 2, 2
    FBusquedasUt.Show vbModal
    
    If GrecibeUbicacion <> 0 Then
        DtcAlmacen.BoundText = GrecibeColumnaID
    End If
End Sub

Private Sub cmdcancelar_Click()
    Unload Me
End Sub

Private Sub cmdCancelar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
    cmdcancelar_Click
End If
End Sub

Private Sub Form_Activate()
    Call gactualizaopcion(pbderecho_agregar, pbderecho_editar, pbderecho_borrar, pbderecho_imprimir)
    Call gactualiza_barra(Me)
    'lineas nuevas
    If pbderecho_consultar = False Then
        Unload Me
    End If
End Sub
Public Sub actualizar_registro()
End Sub

Public Sub primer_registro()
End Sub
Public Sub ultimo_registro()
End Sub
Public Sub registro_anterior()
End Sub
Public Sub registro_siguiente()
End Sub

Private Sub Form_Load()
    'seguridad
    Call gseguridad(Me)
    
    If pbderecho_consultar Then

    Set objAlmacen = New DB_INV_MANTENIMIENTOS.C_ALMACEN
    Set objCorrelativo = New DB_CORRELATIVO.C_Correlativos
    Set objProceso = New DB_UT_MANTENIMIENTOS.C_PROCESOS
    Set objSetup = New UTIL_SETUP.C_SETUP
    Call CargaDataCombo(DtcAlmacen, objAlmacen.ListarAlmacenesPorStatus(1), "SiteId", "Name")
    
    cmbMes.ListIndex = CInt(Month(Now)) - 1
    strMonedaExtranjera = objSetup.ObtenerMonedaExtranjera(GstrCodMonedaBase)
    strUltimoCierre = objSetup.ObtenerUltimoCierre
    
    'dtpAnio.Value = strUltimoCierre & "01"
    dtpAnio.Value = "01/" & Right(strUltimoCierre, 2) & "/" & Left(strUltimoCierre, 4) 'Pablo N.
    
    DtcAlmacen.BoundText = GstrSiteProce
    pb_primerregistro = True
    lblCierre.Caption = strUltimoCierre
    'lineas nuevas
    Else
        'Unload Me
        MsgBox ("No tiene Derechos de Consultar en este formulario"), vbCritical + vbDefaultButton1, "Mensaje"
    End If
    
    Me.Top = 1300
    Me.Left = (Screen.Width - Me.Width) / 2
    
     
End Sub

Private Sub Salir()
    Unload Me
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If pb_editar Then
        If MsgBox("Desea Cancelar los Cambios", vbYesNo, "Esta Modificando un registro") = vbNo Then
            Cancel = True
        Else
            Call gdesactiva_barra
        End If
    Else
        Call gdesactiva_barra
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objAlmacen = Nothing
    Set objCorrelativo = Nothing
    Set objProceso = Nothing
    Set objSetup = Nothing
End Sub

Public Sub salir_formulario()
    Unload Me
End Sub

Public Sub CargaDataCombo(objDataCombo As DataCombo, rsSource As Recordset, istrCampo1 As String, istrCampo2 As String)

    Set objDataCombo.DataSource = rsSource
    objDataCombo.DataField = istrCampo2
    Set objDataCombo.RowSource = rsSource
    objDataCombo.ListField = istrCampo2
    objDataCombo.BoundColumn = istrCampo1
    
    If Not rsSource.EOF Then
        objDataCombo.BoundText = rsSource.Fields(istrCampo2)
    End If

End Sub

Public Function numdias(MES As Integer, anio As Long) As Integer
 Select Case MES
   Case 1
      numdias = 31
   Case 2
      If (anio Mod 4) = 0 Then
       numdias = 29
      Else
       numdias = 28
      End If
   Case 3
      numdias = 31
   Case 4
      numdias = 30
   Case 5
      numdias = 31
   Case 6
      numdias = 30
   Case 7
      numdias = 31
   Case 8
      numdias = 31
   Case 9
      numdias = 30
   Case 10
      numdias = 31
   Case 11
      numdias = 30
   Case 12
      numdias = 31
 End Select
End Function

Private Function ValidaCierre() As Integer
Dim strAnioCerrado As String
Dim strMesCerrado As String
Dim strAnioPorCerrar As String
Dim strMesPorCerrar As String

    strAnioCerrado = Mid(strUltimoCierre, 1, 4)
    strMesCerrado = Mid(strUltimoCierre, 5, 2)
    
    If strMesCerrado = "12" Then
        strMesPorCerrar = "01"
        strAnioPorCerrar = CStr(CInt(Mid(strUltimoCierre, 1, 4)) + 1)
    Else
        strMesPorCerrar = Right("0" + CStr(CInt(strMesCerrado) + 1), 2)
        strAnioPorCerrar = strAnioCerrado
    End If
    
    
    If (CInt(strMes) <= CInt(strMesCerrado)) And (CInt(strAnio) <= CInt(strAnioCerrado)) Then
        ValidaCierre = 0
    Else
        If (CInt(strMes) = CInt(strMesPorCerrar)) And (CInt(strAnio) = CInt(strAnioPorCerrar)) Then
            ValidaCierre = 1
        Else
            ValidaCierre = 2
        End If
    End If

End Function



