Files
SanchoToro/GestionGrupoSanchoToro/Contabilidad/Aplicaciones/ucEjercicioContable.xaml.vb
2026-01-30 11:10:56 +01:00

613 lines
31 KiB
VB.net

Imports DevExpress.Xpf.Editors
Imports DevExpress.Xpf.LayoutControl
Imports tsWPFCore
Imports System.ComponentModel
Imports System.Data
Imports DevExpress.Xpf.Editors.Validation
Imports DevExpress.Xpf.Editors.Helpers
Imports DevExpress.Xpf.Core
Imports System.Data.Common
Imports DevExpress.Xpf.Bars
Imports DevExpress.Xpf.Grid
Imports System.IO
Imports DevExpress.Spreadsheet
Imports Microsoft.Win32
Imports System.Drawing
Imports tsWPFCore.Comun
Imports bdGrupoSanchoToro.db
Imports bdGrupoSanchoToro.db.Utilidades
Imports tsUtilidades
Public Class ucEjercicioContable
Private bd As tscGrupoSanchoToro
Friend _idEjercicio As Nullable(Of Integer)
'
Public Overrides Sub Cargado()
Me.Tipo_ucControlBusqueda = GetType(ucEjerciciosContables)
End Sub
Dim ra As ejercicioscontables
Public Overrides Function EstablecedcPrincipal(Optional Background As Boolean = False, Optional FuerzaNuevo As Boolean = False, Optional Refrescar As Boolean = False) As EstadosAplicacion
Try
Dim NuevoEstado As EstadosAplicacion
If FuerzaNuevo OrElse _idEjercicio Is Nothing Then
ra = New bdGrupoSanchoToro.db.ejercicioscontables
ra.FechaApertura = Now.Date
Dim Anno As Integer = Now.Year
If Now.Month > 1 Then Anno += 1
ra.Descripcion = Anno.ToString
ra.FechaInicio = New Date(Anno, 1, 1)
ra.FechaFin = New Date(Anno, 12, 31)
ra.idEmpresa = bd.empresas.First(Function(x) x.FechaBaja.HasValue = False).idEmpresa
Me.DataContext = ra
_idEjercicio = Nothing
' ra.idEjercicio = Nothing
NuevoEstado = EstadosAplicacion.Nuevo
tsUserControl.EstableceSoloLectura(Me.cbEmpresa, False)
Else
ra = bd.ejercicioscontables.First(Function(x) x.idEjercicio = _idEjercicio)
NuevoEstado = EstadosAplicacion.ModificandoRegistro
tsUserControl.EstableceSoloLectura(Me.cbEmpresa, ra.cuentas.Count > 0 Or ra.asientos.Count > 0)
End If
Me.DataContext = ra
gcAsientos.ItemsSource = ra.asientos
If cbNivel.ItemsSource Is Nothing Then
cbNivel.ItemsSource = bdGrupoSanchoToro.db.cuentas.ListadoGruposCuentas
cbNivel.EditValue = cuentas.LongitudCuentaFinal
Else
' If Not DXSplashScreen.IsActive Then DXSplashScreen.Show(Of tsWPF.SplashScreenTecnosis)()
' DXSplashScreen.SetState("Obteniendo cuentas ...")
ObtieneCuentas(ra)
' If DXSplashScreen.IsActive Then DXSplashScreen.Close()
End If
Return NuevoEstado
Catch ex As Exception
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
FuncionesDinamicas.ErrorNoControladoAp(Me, ex)
DXMessageBox.Show(ex.Message, "Error")
Return EstadosAplicacion.SinDatos
End Try
End Function
Public Overrides Function ObtieneBD() As tsUtilidades.ItsContexto
bd = tscGrupoSanchoToro.NuevoContexto()
Return bd
End Function
Public Overrides ReadOnly Property NombreTablaBase As String
Get
Return "ejercicioscontables"
End Get
End Property
Public Overrides ReadOnly Property idRegistroAplicacionActual As String
Get
If Estado = EstadosAplicacion.Nuevo Then
Me.cbEmpresa.ItemsSource = bd.empresas.Where(Function(x) x.FechaBaja.HasValue = False)
Return "Entidad.Nuevo"
Else
Me.cbEmpresa.ItemsSource = bd.empresas.ToList
Return "Ejercicio." & DirectCast(Me.DataContext, ejercicioscontables).Descripcion.ToString
End If
End Get
End Property
Public Overrides ReadOnly Property DescripcionRegistro As String
Get
Return "Ejercicio Contable"
End Get
End Property
Public Sub New(Optional idEjercicio As Integer? = Nothing)
' Llamada necesaria para el diseñador.
InitializeComponent()
_idEjercicio = idEjercicio
' Agregue cualquier inicialización después de la llamada a InitializeComponent().
End Sub
Public Overrides Sub EstableceTitulo()
If Me.docpanel Is Nothing Then
Dim w As dxwGenerica = Window.GetWindow(Me)
w.Title = "Agregar nuevo ejercicio"
Else
If Me.Estado = EstadosAplicacion.ModificandoRegistro Then
Me.docpanel.Caption = "Ejercicio " & ra.Descripcion
Me.docpanel.Tag = "Ejercicio." & ra.Descripcion
Else
Me.docpanel.Caption = "Ejercicio Nuevo"
Me.docpanel.Tag = "Ejercicio.Nuevo"
End If
End If
End Sub
Public Overrides Function ObtienePermisos() As tsUtilidades.Permisos
Return Comun.ObtienePermisos(Me.bd, "AP.CONTABILIDAD", idUsuario)
End Function
'Public Overrides Function ObtieneConexionBD() As BBDD
' Return bdGrupoSanchoToro.gestionasegasaEntities.bdga
'End Function
Private Sub ap_ValidarControl(sender As Object, e As ValidationEventArgs, ByRef ev As ErrorValidacion, ByRef ValorOriginalCambiado As Object) Handles Me.ValidarControl
Dim pts As PropiedadesTS = sender.parent.propiedadests
If Not pts Is Nothing Then
Dim ra As ejercicioscontables = Me.DataContext
End If
End Sub
Private Sub ObtieneCuentas(ra As ejercicioscontables)
Try
If Not DXSplashScreen.IsActive Then DXSplashScreen.Show(Of tsWPFCore.SplashScreenTecnosis)()
DXSplashScreen.SetState("Obteniendo cuentas ...")
Dim Nivel As Integer = cbNivel.EditValue
Dim ctas = bdGrupoSanchoToro.db.vf_cuentas.Obtiene_vf_cuentas(bd, ra.ideje, Nivel)
gcCuentas.ItemsSource = ctas
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
Catch ex As Exception
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
FuncionesDinamicas.ErrorNoControladoAp(Me, ex)
DXMessageBox.Show(ex.Message, "Error")
End Try
End Sub
Private Sub cbNivel_EditValueChanged(sender As Object, e As EditValueChangedEventArgs) Handles cbNivel.EditValueChanged
ObtieneCuentas(ra)
End Sub
Private Sub HlAsientoRegularizacion_Click(sender As Object, e As RoutedEventArgs)
Dim id = DirectCast(Me.DataContext, ejercicioscontables).AsientoRegularizacion.idAsiento
FuncionesDinamicas.AbrirAP(New ucDiario(id), OtrosParametros)
End Sub
Public Overrides Sub EstableceDataContextSecundarios(Optional Background As Boolean = False)
Dim Acciones As New List(Of tsWPFCore.Accion)
Acciones.Add(New Accion With {
.idAccion = 1,
.Descripcion = "GENERA ASIENTO DE REGULARIZACIÓN Y DE APERTURA"})
Acciones.Add(New Accion With {
.idAccion = 2,
.Descripcion = "REENUMERA Nº ASIENTO OFICIAL"})
Acciones.Add(New Accion With {
.idAccion = 3,
.Descripcion = "GENERA BALANCE DE SITUACION"})
Me.ContenedorAplicacion.cbAcciones.ItemsSource = Acciones
If Acciones.Count > 0 Then Me.ContenedorAplicacion.beAcciones.EditValue = Acciones.First.idAccion
End Sub
Private Sub HlAsientoApertura_Click(sender As Object, e As RoutedEventArgs)
Dim id = DirectCast(Me.DataContext, ejercicioscontables).AsientoApertura.idAsiento
FuncionesDinamicas.AbrirAP(New ucDiario(id), OtrosParametros)
End Sub
Private Sub ap_Enlazar(Celda As EditGridCellData, Defecto As Boolean) Handles Me.Enlazar
Select Case Celda.Column.FieldName.ToLower
Case "idasiento"
Dim id As Integer = DirectCast(Me.gcAsientos.CurrentItem, asientos).idAsiento
FuncionesDinamicas.AbrirAP(New ucDiario(id), OtrosParametros)
Case "idcuenta"
Dim id As Integer = DirectCast(Me.gcCuentas.CurrentItem, vf_cuentas).idCuenta
FuncionesDinamicas.AbrirAP(New ucCuenta(id), OtrosParametros)
End Select
End Sub
Private Sub ap_DespuesGuardar(sender As Object, e As ItemClickEventArgs, OpcionGuardado As Integer) Handles Me.DespuesGuardar
Dim NuevoEjercicio As ejercicioscontables = ra
_idEjercicio = NuevoEjercicio.idEjercicio
If NuevoEjercicio.FechaCierre.HasValue = False AndAlso NuevoEjercicio.FechaApertura.Year = Now.Year Then
Dim ea = bd.ejercicioscontables.OrderByDescending(Function(x) x.FechaInicio).FirstOrDefault(Function(x) x.FechaInicio < NuevoEjercicio.FechaInicio)
If DXMessageBox.Show("¿Desea copiar las cuentas del Ejercicio Anterior?", "Atención", vbYesNo) = MessageBoxResult.Yes Then
CopiaCuentas(NuevoEjercicio)
RefrescaUC(True)
End If
End If
End Sub
Friend Sub CopiaCuentas(NuevoEjercicio As ejercicioscontables)
Try
Dim ea = bd.ejercicioscontables.OrderByDescending(Function(x) x.FechaInicio).FirstOrDefault(Function(x) x.FechaInicio < NuevoEjercicio.FechaInicio)
If ea IsNot Nothing Then
If Not DXSplashScreen.IsActive Then DXSplashScreen.Show(Of tsWPFCore.SplashScreenTecnosis)()
DXSplashScreen.SetState("Copiando Cuentas del Ejercicio " & ea.Descripcion & " ...")
Dim ctas1 = ea.cuentas.Where(Function(x) x.NumeroCuenta.Length = 1).ToList
Dim ctas2 = ea.cuentas.Where(Function(x) x.NumeroCuenta.Length = 2).ToList
Dim ctas3 = ea.cuentas.Where(Function(x) x.NumeroCuenta.Length = 3).ToList
Dim ctas4 = ea.cuentas.Where(Function(x) x.NumeroCuenta.Length = 4).ToList
Dim ctas8 = ea.cuentas.Where(Function(x) x.NumeroCuenta.Length = 8).ToList
Dim Nc As Integer = 0
For Each cta In ctas1
Nc += CopiaCuenta(bd, NuevoEjercicio, cta)
Next
For Each cta In ctas2
Nc += CopiaCuenta(bd, NuevoEjercicio, cta)
Next
For Each cta In ctas3
Nc += CopiaCuenta(bd, NuevoEjercicio, cta)
Next
For Each cta In ctas4
Nc += CopiaCuenta(bd, NuevoEjercicio, cta)
Next
For Each cta In ctas8
Nc += CopiaCuenta(bd, NuevoEjercicio, cta)
Next
bd.GuardarCambios()
DXSplashScreen.Close()
'DXMessageBox.Show("Se han copiado " & (ctas1.Count + ctas2.Count + ctas3.Count + ctas4.Count + ctas8.Count).ToString & " Cuentas", "Información")
DXMessageBox.Show("Se han copiado " & Nc.ToString, "Información")
End If
Catch ex As Exception
FuncionesDinamicas.ErrorNoControladoAp(Me, ex)
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
DXMessageBox.Show(ex.Message, "Error")
Finally
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
End Try
End Sub
Friend Function CopiaCuenta(bdtmp As tscGrupoSanchoToro, NuevoEjercicio As ejercicioscontables, CtaAnterior As cuentas, Optional ByRef CuentaNueva As cuentas = Nothing) As Integer
If Not NuevoEjercicio.cuentas.Any(Function(X) X.NumeroCuenta = CtaAnterior.NumeroCuenta) Then
Dim nc As New cuentas
nc.Denominacion = CtaAnterior.Denominacion
nc.EsCuentaFinal = CtaAnterior.EsCuentaFinal
nc.Mote = CtaAnterior.Mote
nc.Observaciones = CtaAnterior.Observaciones
nc.NumeroCuenta = CtaAnterior.NumeroCuenta
nc.idEjercicio = NuevoEjercicio.idEjercicio
nc.idEmpresaAmortizacion = CtaAnterior.idEmpresaAmortizacion
nc.PresupuestoEnero = CtaAnterior.PresupuestoEnero
nc.PresupuestoFebrero = CtaAnterior.PresupuestoFebrero
nc.PresupuestoMarzo = CtaAnterior.PresupuestoMarzo
nc.PresupuestoAbril = CtaAnterior.PresupuestoAbril
nc.PresupuestoMayo = CtaAnterior.PresupuestoMayo
nc.PresupuestoJunio = CtaAnterior.PresupuestoJunio
nc.PresupuestoJulio = CtaAnterior.PresupuestoJulio
nc.PresupuestoAgosto = CtaAnterior.PresupuestoAgosto
nc.PresupuestoSeptiembre = CtaAnterior.PresupuestoSeptiembre
nc.PresupuestoOctubre = CtaAnterior.PresupuestoOctubre
nc.PresupuestoNoviembre = CtaAnterior.PresupuestoNoviembre
nc.PresupuestoDiciembre = CtaAnterior.PresupuestoDiciembre
bdtmp.cuentas.Add(nc)
CuentaNueva = nc
Return 1
Else
CuentaNueva = Nothing
Return 0
End If
End Function
Friend Sub ReenumeraAsientosOficiales()
Try
If Estado = EstadosAplicacion.Nuevo Then
DXMessageBox.Show("No se puede realizar esta operación en ejercicios nuevos", "Atención")
Else
bd = bdGrupoSanchoToro.tscGrupoSanchoToro.NuevoContexto
Dim ejact As ejercicioscontables = bd.ejercicioscontables.Where(Function(x) x.idEjercicio = ra.idEjercicio)
Dim asap = bd.asientos.FirstOrDefault(Function(x) x.idEjercicio = ejact.idEjercicio AndAlso x.Tipo = bdGrupoSanchoToro.db.asientos.TipoAsiento.APERTURA)
Dim asci = bd.asientos.FirstOrDefault(Function(x) x.idEjercicio = ejact.idEjercicio And x.Tipo = bdGrupoSanchoToro.db.asientos.TipoAsiento.REGULARIZACION)
bd.Database.ExecuteSqlRaw("UPDATE ASIENTOS SET NumeroAsiento=null where idEjercicio=" & ejact.idEjercicio.ToString & ";")
Dim asn = bd.asientos.Where(Function(x) x.idEjercicio = ejact.idEjercicio And x.Tipo = bdGrupoSanchoToro.db.asientos.TipoAsiento.NORMAL).ToList
Dim cont = 0
If asap IsNot Nothing Then
cont += 1
asap.NumeroAsiento = cont
End If
For Each asi In asn
cont += 1
asap.NumeroAsiento = cont
Next
If asci IsNot Nothing Then
cont += 1
asap.NumeroAsiento = cont
End If
bd.GuardarCambios()
End If
Catch ex As Exception
End Try
End Sub
Friend Sub GeneraAsientoRegularizacionYApertura()
Try
If Estado = EstadosAplicacion.Nuevo Then
DXMessageBox.Show("No se puede realizar esta operación sobre ejercicios nuevos", "Atención")
Else
bd = bdGrupoSanchoToro.tscGrupoSanchoToro.NuevoContexto
Dim ejact As ejercicioscontables = bd.ejercicioscontables.FirstOrDefault(Function(x) x.idEjercicio = ra.idEjercicio)
Dim ejnue As ejercicioscontables = bd.ejercicioscontables.FirstOrDefault(Function(x) x.FechaInicio > ejact.FechaInicio)
If ejnue Is Nothing Then
DXMessageBox.Show("Antes debe crear el nuevo ejercicio", "Información")
Else
Dim Continua As Boolean = True
If ejact.FechaCierre.HasValue OrElse ejnue.FechaCierre.HasValue Then
DXMessageBox.Show("Alguno de los ejerccicios implicados ya están cerrados. Si desea volverlo a cerrar primero debe quitar dicha fecha.", "Atención")
Else
Dim AsiCie = bd.asientos.FirstOrDefault(Function(x) x.idEjercicio = ejact.idEjercicio And x.Tipo = bdGrupoSanchoToro.db.asientos.TipoAsiento.REGULARIZACION)
Dim AsiAper = bd.asientos.FirstOrDefault(Function(x) x.idEjercicio = ejnue.idEjercicio And x.Tipo = asientos.TipoAsiento.APERTURA)
If AsiCie IsNot Nothing OrElse AsiAper IsNot Nothing Then Continua = DXMessageBox.Show("Ya existe un asiento de regularización/apertura en los ejercicios implicados. ¿Desea eliminar dichos asientos y generarlos de nuevo?", "Atención", MessageBoxButton.YesNo) = MessageBoxResult.Yes
If Continua Then
If Not DXSplashScreen.IsActive Then DXSplashScreen.Show(Of tsWPFCore.SplashScreenTecnosis)()
DXSplashScreen.SetState("Generando Cierre Ejercicio " & ejact.Descripcion & " ...")
If AsiCie IsNot Nothing Then
bd.asientos.Remove(AsiCie)
bd.GuardarCambios()
End If
Dim ctasgr6Y7 = bd.cuentas.Where(Function(x) x.idEjercicio = ejact.idEjercicio And x.EsCuentaFinal And (x.NumeroCuenta.StartsWith("6") Or x.NumeroCuenta.StartsWith("7"))).OrderBy(Function(X) X.NumeroCuenta).ToList.Where(Function(x) x.TotalSaldo <> 0)
Dim asireg As New asientos
bd.asientos.Add(asireg)
With asireg
.Fecha = ejact.FechaFin
.idEjercicio = ejact.idEjercicio
.idUsuario = idUsuario
.Tipo = bdGrupoSanchoToro.db.asientos.TipoAsiento.REGULARIZACION
End With
For Each cta In ctasgr6Y7
Dim na As New apuntes
asireg.apuntes.Add(na)
With na
.idCuenta = ejact.cuentas.First(Function(x) x.NumeroCuenta = cta.NumeroCuenta).idCuenta
' .Fecha = ejact.FechaFin
.Concepto = "A PERDIDAS Y GANANCIAS"
' If cta.TotalSaldo > 0 Then
If cta.NumeroCuenta.StartsWith("6") Then
.Debe = 0
.Haber = Math.Round(cta.TotalSaldo, 2, MidpointRounding.AwayFromZero)
Else
.Debe = Math.Round(cta.TotalSaldo * -1, 2, MidpointRounding.AwayFromZero)
.Haber = 0
End If
'Else
' .Debe = cta.TotalSaldo * -1
' .Haber = 0
'End If
asireg.Importe = Math.Round(asireg.Importe + .Debe, 2, MidpointRounding.AwayFromZero)
End With
Dim naPYG As New apuntes
asireg.apuntes.Add(naPYG)
With naPYG
.idCuenta = ejact.cuentas.First(Function(x) x.NumeroCuenta = bdGrupoSanchoToro.db.cuentas.CUENTA_PERDIDAS_Y_GANANCIAS).idCuenta
'.Fecha = ejact.FechaFin
.Concepto = cta.Denominacion
' If cta.TotalSaldo > 0 Then
If cta.NumeroCuenta.StartsWith("6") Then
.Debe = Math.Round(cta.TotalSaldo, 2, MidpointRounding.AwayFromZero)
.Haber = 0
Else
.Debe = 0
.Haber = Math.Round(cta.TotalSaldo * -1, 2, MidpointRounding.AwayFromZero)
End If
'Else
' .Debe = 0
' .Haber = cta.TotalSaldo * -1
'End If
asireg.Importe = Math.Round(asireg.Importe + .Debe, 2, MidpointRounding.AwayFromZero)
End With
Next
asireg.Importe = Math.Round(asireg.Importe, 2, MidpointRounding.AwayFromZero)
bd.GuardarCambios()
'
' APERTURA
'
DXSplashScreen.SetState("Generando Apertura Ejercicio " & ejnue.Descripcion & " ...")
' Dim AsiAper = bd.asientos.FirstOrDefault(Function(x) x.idEjercicio = ejnue.idEjercicio And x.Tipo = asientos.TipoAsiento.APERTURA)
If AsiAper IsNot Nothing Then
bd.asientos.Remove(AsiAper)
bd.GuardarCambios()
End If
bd = bdGrupoSanchoToro.tscGrupoSanchoToro.NuevoContexto
ejact = bd.ejercicioscontables.FirstOrDefault(Function(x) x.idEjercicio = ra.idEjercicio)
ejnue = bd.ejercicioscontables.FirstOrDefault(Function(x) x.FechaInicio > ejact.FechaInicio)
' Dim ctas = bd.Obtiene_ve_cuentas(bd.apuntes.Where(Function(x) x.asientos.idEjercicio = ejact.idEjercicio)).Where(Function(x) x.TotalDebe - x.TotalHaber <> 0).OrderBy(Function(X) X.NumeroCuenta).ToList
Dim ctas = bdGrupoSanchoToro.db.vf_cuentas.Obtiene_vf_cuentas(bd, ejact.idEjercicio, 8).Where(Function(x) x.TotalDebe - x.TotalHaber <> 0).OrderBy(Function(X) X.NumeroCuenta).ToList
Dim NueAsiAper As New asientos
bd.asientos.Add(NueAsiAper)
With NueAsiAper
.Fecha = ejnue.FechaInicio
.idEjercicio = ejnue.idEjercicio
.idUsuario = idUsuario
.Tipo = bdGrupoSanchoToro.db.asientos.TipoAsiento.APERTURA
End With
For Each cta In ctas
Dim na As New apuntes
NueAsiAper.apuntes.Add(na)
With na
Dim ctne = ejnue.cuentas.FirstOrDefault(Function(x) x.NumeroCuenta = cta.NumeroCuenta)
If ctne Is Nothing Then
Dim ctaea = bd.cuentas.First(Function(x) x.idCuenta = cta.idCuenta)
CopiaCuenta(bd, ejnue, ctaea, ctne)
End If
.cuentas = ctne
'.idCuenta = ejnue.cuentas.First(Function(x) x.NumeroCuenta = cta.NumeroCuenta).idCuenta
'.Fecha = ejnue.FechaInicio
.Concepto = "ASIENTO APERTURA"
If cta.TotalSaldo > 0 Then
.Haber = 0
.Debe = Math.Round(cta.TotalSaldo, 2, MidpointRounding.AwayFromZero)
Else
.Haber = Math.Round(cta.TotalSaldo * -1, 2, MidpointRounding.AwayFromZero)
.Debe = 0
End If
NueAsiAper.Importe += .Debe
End With
Next
NueAsiAper.Importe = Math.Round(NueAsiAper.Importe, 2, MidpointRounding.AwayFromZero)
bd.GuardarCambios()
RefrescaUC()
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
DXMessageBox.Show("Asiento de Regularización y Apertura creado correctamente.", "Atención")
End If
End If
End If
End If
Catch ex As Exception
FuncionesDinamicas.ErrorNoControladoAp(Me, ex)
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
DXMessageBox.Show(ex.Message, "Error")
Finally
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
End Try
End Sub
Private Sub ap_EjecutarAccion(sender As Object, e As ItemClickEventArgs, idAccion As Integer) Handles Me.EjecutarAccion
Select Case idAccion
Case 1 ' GENERA ASIENTO DE CIERRE Y APERTURA
GeneraAsientoRegularizacionYApertura()
Case 2 ' REENUMERA ASIENTOS OFICIALES Y CIERRA EL EJERCCIO
ReenumeraAsientosOficiales()
Case 3
GeneraInformeContable("BALSIT")
End Select
End Sub
Public Sub GeneraInformeContable(Codigo As String)
Try
If Estado = EstadosAplicacion.Nuevo Then
DXMessageBox.Show("No se puede realizar esta operación sobre ejercicios nuevos", "Atención")
Else
Dim fb As New SaveFileDialog
Dim ic = bd.informescontables.First(Function(x) x.Codigo = Codigo)
fb.FileName = ic.Descripcion & " " & Now.ToString("dd-MM-yyyy")
fb.Filter = "Fichero Excel | *.xlsx"
fb.DefaultExt = "xlsx"
fb.FileName &= ".xlsx"
fb.AddExtension = True
If fb.ShowDialog Then
bd = bdGrupoSanchoToro.tscGrupoSanchoToro.NuevoContexto
If Not DXSplashScreen.IsActive Then DXSplashScreen.Show(Of tsWPFCore.SplashScreenTecnosis)()
DXSplashScreen.SetState("Generando Informe ...")
Dim ej As ejercicioscontables = bd.ejercicioscontables.First(Function(x) x.idEjercicio = ra.idEjercicio)
Dim b() As Byte = ic.idFicheroNavigation.Fichero
Dim ms As New MemoryStream(b)
Dim wb As New Workbook
If ic.idFicheroNavigation.NombreFichero.ToLower.EndsWith(".xls") Then
wb.LoadDocument(ms, DevExpress.Spreadsheet.DocumentFormat.Xls)
Else
wb.LoadDocument(ms, DevExpress.Spreadsheet.DocumentFormat.Xlsx)
End If
Dim ctas = ej.cuentas.ToList
Dim ctasejant As New List(Of cuentas)
Dim ejant = bd.ejercicioscontables.Where(Function(x) x.FechaInicio < ej.FechaInicio).OrderByDescending(Function(x) x.FechaInicio).FirstOrDefault
If ejant IsNot Nothing Then
ctasejant = ejant.cuentas.ToList
End If
For Each c In ic.celdasinformescontables
Dim celda As String = c.Columna & c.Fila.ToString
Try
Select Case c.NombreCampo.ToLower
Case "totalsaldoejant"
If ejant IsNot Nothing Then wb.Worksheets(c.Hoja).Cells(celda).Value = ObtieneTotalSaldo(ctasejant, c)
Case "totalsaldo"
wb.Worksheets(c.Hoja).Cells(celda).Value = ObtieneTotalSaldo(ctas, c)
Case "totalsaldoac" 'Antes de CIERRE
wb.Worksheets(c.Hoja).Cells(celda).Value = ObtieneTotalSaldoAC(ctas, c)
Case "totalsaldoacejant" 'Antes de CIERRE
If ejant IsNot Nothing Then wb.Worksheets(c.Hoja).Cells(celda).Value = ObtieneTotalSaldoAC(ctasejant, c)
Case "ejercicio"
wb.Worksheets(c.Hoja).Cells(celda).Value = ej.Descripcion
Case "ejercicioant"
If ejant IsNot Nothing Then wb.Worksheets(c.Hoja).Cells(celda).Value = ejant.Descripcion
End Select
Catch ex As Exception
Throw New Exception("Error en Hoja " & c.Hoja.ToString & " Columna " & celda & " " & ex.Message, ex)
End Try
Next
wb.SaveDocument(fb.FileName, DevExpress.Spreadsheet.DocumentFormat.Xlsx)
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
Process.Start(fb.FileName)
End If
End If
Catch ex As Exception
FuncionesDinamicas.ErrorNoControladoAp(Me, ex)
If DXSplashScreen.IsActive Then DXSplashScreen.Close()
DXMessageBox.Show(ex.Message, "Error")
End Try
End Sub
Private Function ObtieneTotalSaldo(ctas As List(Of cuentas), c As celdasinformescontables) As Double
Dim Total As Double = 0
Dim ctascelda = c.cuentasceldasinformescontables.ToList
For Each cc In ctascelda
Dim cta = ctas.FirstOrDefault(Function(x) x.NumeroCuenta = cc.NumeroCuenta)
If cta IsNot Nothing Then
If cc.SoloSiNegativo Then
If cta.TotalSaldo < 0 Then Total += (cta.TotalSaldo * cc.Factor)
Else
If cc.SoloSiPositivo Then
If cta.TotalSaldo > 0 Then Total += (cta.TotalSaldo * cc.Factor)
Else
Total += (cta.TotalSaldo * cc.Factor)
End If
End If
End If
Next
Return Total
End Function
Private Function ObtieneTotalSaldoAC(ctas As List(Of cuentas), c As celdasinformescontables) As Double
Dim Total As Double = 0
Dim ctascelda = c.cuentasceldasinformescontables.ToList
For Each cc In ctascelda
Dim cta = ctas.FirstOrDefault(Function(x) x.NumeroCuenta = cc.NumeroCuenta)
If cta IsNot Nothing Then
If cc.SoloSiNegativo Then
If cta.TotalSaldoAntesCierre < 0 Then Total += (cta.TotalSaldoAntesCierre * cc.Factor)
Else
If cc.SoloSiPositivo Then
If cta.TotalSaldoAntesCierre > 0 Then Total += (cta.TotalSaldoAntesCierre * cc.Factor)
Else
Total += (cta.TotalSaldoAntesCierre * cc.Factor)
End If
End If
End If
Next
Return Total
End Function
Private Sub EstableceEstiloGrupo(rg As DevExpress.Spreadsheet.CellRange)
Dim rgf As Formatting = rg.BeginUpdateFormatting
rgf.Font.Bold = True
rgf.Fill.BackgroundColor = Color.LightCyan
rgf.Borders.BottomBorder.LineStyle = BorderLineStyle.DashDot
rgf.Borders.TopBorder.LineStyle = BorderLineStyle.DashDot
rgf.Borders.LeftBorder.LineStyle = BorderLineStyle.DashDot
rgf.Borders.RightBorder.LineStyle = BorderLineStyle.DashDot
End Sub
Private Sub ucEjercicioContable_EstadoCambiado(EstadoAnterior As EstadosAplicacion, EstadoNuevo As EstadosAplicacion) Handles Me.EstadoCambiado
End Sub
'Private Sub ucEjercicioContable_AbreRegistroBuscado(uc As tsUserControl) Handles Me.AbreRegistroBuscado
'End Sub
'Private Sub ucEjercicioContable_AbreRegistroBuscado(uc As tsUserControl) Handles Me.AbreRegistroBuscado
' Dim ucecs = DirectCast(uc, ucEjerciciosContables)
' _idEjercicio = DirectCast(ucecs.gcEjercicios.CurrentItem, ejercicioscontables).idEjercicio
'End Sub
End Class