.
Este procedimiento de VBA o Macro de Excel determina el saldo por proveedor o puede usarse para clientes,entre fecha y fecha, también se puede adaptar el ejemplo para tener gestionada una cuenta bancaria propia como por ejemplo la de MASTERCARD PAYONEER (si aún no la tienes puedes gestionarla desde el siguiente link); entregando un informe detallado de todos los movimientos que ha tenido la cuenta en el períodos seleccionado, o si se tilda la
casilla correspondiente hace un resumen de todas la cuentas que tengan saldo distinto de cero, emitiendo un listado con todos los saldos dentro de los 60
días anteriores a la fecha del sistema; haciendo click en el link del final podrás descargar el ejemplo.
Código que se introduce en formulario
Private Sub CheckBox1_AfterUpdate()
If CheckBox1.Value = True Then
TextBox3.Enabled = False
ComboBox1.Enabled = False
TextBox1.Enabled = False
TextBox2.Enabled = False
Else
TextBox3.Enabled = True
ComboBox1.Enabled = True
TextBox1.Enabled = True
TextBox2.Enabled = True
End If
End Sub
Private Sub ComboBox1_AfterUpdate()
Dim quebusco As String
Dim rangoabuscar As String
Dim busca As Object
Dim numerocuenta As String
rangoabuscar = «b2:b10000»
quebusco = ComboBox1.Value
Set busca = Sheets(«Proveedores»).Range(rangoabuscar).Find(quebusco, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing Then
TextBox3.Value = busca.Offset(0, -1)
Else
ComboBox1.SetFocus
MsgBox «El Proveedor no existe», vbCritical
End If
TextBox1 = CDate(Date – 60)
TextBox2 = CDate(Date)
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
‘Controlo errores
On Error Resume Next
‘Busca todos los Proveedores con saldo mayor a 0, si el checkbox es igual a true
If CheckBox1.Value = True Then
‘Muestra progressbar
Unload Me
ProgressForm.Show False
Dim R As Integer
Dim MT As Double
For R = 1 To 10
MT = Timer
ProgressForm.ProgressBar1.Max = 10
Do
Loop While Timer – MT < 0.05
ProgressForm.ProgressBar1.Value = R
DoEvents
Next R
Unload ProgressForm
‘Borra el contenido de la hoja saldo antes de empezar a calcular y pegar en celdas
Sheets(«saldo»).Visible = True
Sheets(«saldo»).Select
Sheets(«saldo»).Unprotect Password:=»1111″
Range(«d5:d7,c6,c10,f7,f5:g5,e10:f10,c10:h65536»).ClearContents
‘Busca los facturas ingresadas
Dim filafacturasST As Integer
Dim filapagosST As Integer
Dim filaProveedoresST As Integer
Dim filasaldoST As Integer
Dim facturasST As Currency
Dim AcumulafacturasST As Currency
Dim pagosST As Currency
Dim AcumulaPagoST As Currency
Dim saldoST As Currency
Dim cond1ST As String
Dim cond2ST As String
Dim cond3ST As String
Dim valor As Integer
Dim midate As Date
Dim dato1ST As String
Dim dato2ST As String
Dim dato3ST As String
filafacturasST = 2
filapagosST = 2
filaProveedoresST = 2
filasaldoST = 10
cond1ST = «Cancelada»
cond2ST = «Anulada»
cond3ST = «Falso»
‘Busca importe de facturas
Sheets(«dbcomp»).Visible = True
Sheets(«Proveedores»).Visible = True
While Sheets(«Proveedores»).Cells(filaProveedoresST, 2) <> Empty
dato1ST = Sheets(«Proveedores»).Cells(filaProveedoresST, 2).Value
While Sheets(«dbcomp»).Cells(filafacturasST, 3).Value <> Empty
If dato1ST = Sheets(«dbcomp»).Cells(filafacturasST, 3).Value <> Empty And _
Sheets(«dbcomp»).Cells(filafacturasST, 13).Value <> cond2ST Then
facturasST = Sheets(«dbcomp»).Cells(filafacturasST, 8).Value
filafacturasST = filafacturasST + 1
Else
filafacturasST = filafacturasST + 1
End If
AcumulafacturasST = AcumulafacturasST + facturasST
facturasST = 0
Wend
‘Seguidamente busca pagos realizados antes de la ficha inicial
While Sheets(«dbcomp»).Cells(filapagosST, 3).Value <> Empty
dato2ST = Sheets(«dbcomp»).Cells(filapagosST, 13).Value
dato3ST = Sheets(«dbcomp»).Cells(filapagosST, 9).Value
If dato1ST = Sheets(«dbcomp»).Cells(filapagosST, 3).Value And _
(dato2ST = cond1ST Or dato3ST = cond3ST) Then
pagosST = Sheets(«dbcomp»).Cells(filapagosST, 8).Value
filapagosST = filapagosST + 1
Else
filapagosST = filapagosST + 1
End If
AcumulaPagoST = AcumulaPagoST + pagosST
pagosST = 0
Wend
saldoST = AcumulafacturasST – AcumulaPagoST
If saldoST <> 0 Then
Sheets(«saldo»).Cells(filasaldoST, 3).Value = Date
Sheets(«saldo»).Cells(filasaldoST, 4).Value = UCase(Sheets(«Proveedores»).Cells(filaProveedoresST, 2).Value)
Sheets(«saldo»).Cells(filasaldoST, 5).Value = AcumulaPagoST
Sheets(«saldo»).Cells(filasaldoST, 6).Value = AcumulafacturasST
Sheets(«saldo»).Cells(filasaldoST, 7).Value = saldoST
Sheets(«saldo»).Range(«d5») = «Todas»
Sheets(«saldo»).Range(«d6») = «Todos»
Sheets(«saldo»).Range(«d7») = midate
Sheets(«saldo»).Range(«c6») = «Proveedores:»
filasaldoST = filasaldoST + 1
End If
filaProveedoresST = filaProveedoresST + 1
AcumulafacturasST = 0
AcumulaPagoST = 0
saldoST = 0
filafacturasST = 2
filapagosST = 2
Wend
‘Ordena por fecha en forma ascendente y por concepto todo lo que parezca número
Sheets(«SALDO»).Select
Range(«C10:h65500»).Sort Key1:=Range(«C10»), Order1:=xlAscending, Key2:=Range(«D10»), _
Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortNormal
‘Llama a la rutina para dar formato
FormatoCeldasSaldo
‘Determina el total adeudado a los proveedores
valor = 0
Range(«g9»).Select
While ActiveCell <> Empty
ActiveCell.Offset(1, 0).Select
valor = valor + ActiveCell.Value
Wend
Range(«f7») = valor
‘Se oculta también la hoja cancela op , porque el saldo puede ser consuldado desde ahí
‘Sheets(«cancela oP»).Visible = xlVeryHidden
‘Sheets(«dbcomp»).Visible = xlVeryHidden
‘Sheets(«Proveedores»).Visible = xlVeryHidden
Sheets(«saldo»).Protect Password:=»1111″
Sheets(«saldo»).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection
Sheets(«saldo»).Activate
ActiveWindow.ScrollRow = 7
Unload Me
Exit Sub
End If
‘Si el check box no está tildado (es falso y quiero conocer el detalle) empieza la rutina desde aquí
‘valida datos de el textbox1 Fecha
If Not IsDate(TextBox1.Text) Then
MsgBox «fecha inválida»
TextBox1.SetFocus
Exit Sub
End If
‘Valida fecha
Dim ubica1, ubica2 As String
Dim dia, mes As Integer
Dim año, fecha As Integer
On Error Resume Next
‘guardamos en variables el caracter encontrado en la posición 3 y 6
ubica1 = Mid(TextBox1.Text, 3, 1)
ubica2 = Mid(TextBox1.Text, 6, 1)
‘comparamos si se trata de ‘/’
If ubica1 <> «/» Or ubica2 <> «/» Then
MsgBox («Debes ingresar datos con este formato: dd/mm/aa»)
TextBox1.SetFocus
Exit Sub
End If
dia = Mid(TextBox1.Value, 1, 2)
mes = Mid(TextBox1.Value, 4, 2)
año = Mid(TextBox1.Value, 7, 4)
fecha = Len(TextBox1)
‘Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia > 31 Or mes > 12 Or año < 1900 Or fecha > 10 Then
MsgBox «Fecha incorrecta»
TextBox1.SetFocus
Exit Sub
End If
‘valida datos de el textbox2 Fecha
If Not IsDate(TextBox2.Text) Then
MsgBox «fecha inválida»
TextBox2.SetFocus
Exit Sub
End If
‘Valida fecha
Dim ubica3, ubica4 As String
Dim dia1, mes1 As Integer
Dim año1, fecha1 As Integer
‘guardamos en variables el caracter encontrado en la posición 3 y 6
ubica3 = Mid(TextBox2.Text, 3, 1)
ubica4 = Mid(TextBox2.Text, 6, 1)
‘comparamos si se trata de ‘/’
If ubica3 <> «/» Or ubica4 <> «/» Then
MsgBox («Debes ingresar datos con este formato: dd/mm/aa»)
TextBox2.SetFocus
Exit Sub
End If
dia1 = Mid(TextBox2.Value, 1, 2)
mes1 = Mid(TextBox2.Value, 4, 2)
año1 = Mid(TextBox2.Value, 7, 4)
fecha1 = Len(TextBox2)
‘Controla lo ingresado, si no se cumple no es fecha y sale en msgbox
If dia1 > 31 Or mes1 > 12 Or año1 < 1900 Or fecha1 > 10 Then
MsgBox «Fecha incorrecta»
TextBox2.SetFocus
Exit Sub
End If
‘Controla que la fecha final no sea menor a la inicial
Dim fechainicio As Date
Dim fechafinal As Date
fechainicio = TextBox1.Value
fechafinal = TextBox2.Value
If fechainicio > fechafinal Then
MsgBox «Fecha inválida»
TextBox2.SetFocus
Exit Sub
End If
‘Controla que la fecha inicial no sea mayor a la fecha actual
Dim condicionfecha As Date
condicionfecha = TextBox1.Value
If condicionfecha > Date Then
MsgBox «La fecha inicial no puede ser mayor a la fecha actual»
Exit Sub
End If
If ComboBox1 = Empty Or TextBox1 = Empty Or TextBox2 = Empty Then
MsgBox «Debe completar todos los campos»
ComboBox1.SetFocus
Exit Sub
End If
Unload Me
ProgressForm.Show False
Dim R1 As Integer
Dim MT1 As Double
For R1 = 1 To 10
MT1 = Timer
ProgressForm.ProgressBar1.Max = 10
Do
Loop While Timer – MT1 < 0.05
ProgressForm.ProgressBar1.Value = R1 ‘»Progress: » & R & » de 180: » & _
‘Format(R / 180, «Percent») & » — » & «Cumplimiento»
DoEvents
Next R1
Unload ProgressForm
‘Hace la hoja visible porque si no provoca error
‘Selecciona la hoja donde va a pegar datos
‘Desproteje la hoja
‘Borra el contenido de la hoja saldo antes de empezar a calcular y pegar en celdas
Sheets(«saldo»).Visible = True
Sheets(«saldo»).Select
ActiveSheet.Unprotect Password:=»1111″
Range(«d5:d7,c6,c10,f5:g5,f7,e10:f10,c10:h65536»).ClearContents
Sheets(«dbcomp»).Visible = True
‘calcula saldo el saldo inicial para ello primero busca las facturas con fecha
‘menor a la fecha inicial y luego los pagos con fecha menor a la fecha inicial
Dim filafacturasSI As Integer
Dim filapagosSI As Integer
Dim factura As Currency
Dim Acumulafactura As Currency
Dim pagos As Currency
Dim AcumulaP As Currency
Dim saldo As Currency
Dim cond1SI As String
Dim cond2SI As Date
Dim cond3SI As String
Dim cond4SI As String
Dim dato1SI As String
Dim dato2SI As Date
Dim dato3SI As String
Dim dato4SI As String
filafacturasSI = 2
filapagosSI = 2
cond1SI = ComboBox1.Value
cond2SI = TextBox1.Value
cond3SI = «Cancelada»
cond4SI = «Anulada»
‘Busca importe de facturas menores a la ficha inicial
‘Compara si es menor a la fecha inicial y pertenece al Proveedores seleccionado
While Sheets(«dbcomp»).Cells(filafacturasSI, 1) <> Empty
dato1SI = Sheets(«dbcomp»).Cells(filafacturasSI, 3).Value
dato2SI = Sheets(«dbcomp»).Cells(filafacturasSI, 1).Value
If dato1SI = cond1SI And _
dato2SI < cond2SI And _
Sheets(«dbcomp»).Cells(filafacturasSI, 13).Value <> cond4SI Then
factura = Sheets(«dbcomp»).Cells(filafacturasSI, 8).Value
filafacturasSI = filafacturasSI + 1
Else
filafacturasSI = filafacturasSI + 1
End If
Acumulafactura = Acumulafactura + factura
factura = 0
Wend
‘Seguidamente busca pagos realizados antes de la ficha inicial
While Sheets(«dbcomp»).Cells(filapagosSI, 1) <> Empty
dato1SI = Sheets(«dbcomp»).Cells(filapagosSI, 3).Value
dato2SI = Sheets(«dbcomp»).Cells(filapagosSI, 1).Value
dato4SI = Sheets(«dbcomp»).Cells(filapagosSI, 13).Value
If dato1SI = cond1SI And _
dato2SI < cond2SI And _
dato4SI = cond3SI Then
pagos = Sheets(«dbcomp»).Cells(filapagosSI, 8).Value
filapagosSI = filapagosSI + 1
Else
filapagosSI = filapagosSI + 1
End If
AcumulaP = AcumulaP + pagos
pagos = 0
Wend
saldo = Acumulafactura – AcumulaP
‘Se fija si el saldo es menor o mayor a cero y lo pone en la columna del debe o haber
‘Sheets(«saldo»).Unprotect Password:=»1111″
If saldo < 0 Then
Sheets(«saldo»).Cells(10, 5) = saldo * -1
Sheets(«saldo»).Cells(10, 7) = saldo
Else
Sheets(«saldo»).Select
ActiveSheet.Unprotect Password:=»1111″
Sheets(«saldo»).Cells(10, 6) = saldo
Sheets(«saldo»).Cells(10, 7) = saldo
End If
‘Agrega Proveedores de proveedor/cliente, cuenta, fecha etc
Sheets(«saldo»).Range(«d5») = TextBox3.Value
Sheets(«saldo»).Range(«d6») = ComboBox1.Value
Sheets(«saldo»).Range(«d7») = Date
Sheets(«saldo»).Range(«c6») = «Proveedores:»
Sheets(«saldo»).Range(«f5») = CDate(TextBox1)
Sheets(«saldo»).Range(«g5») = CDate(TextBox2)
‘ Luego de calcular el saldo inicial busca los datos entre las fechas ingresadas
Dim filapagos As Integer
Dim filasaldo As Integer
Dim dato1 As String
Dim dato2 As Date
Dim dato3 As Date
Dim dato4 As String
Dim dato5 As String
Dim dato6 As String
Dim cond1 As String
Dim cond2 As Date
Dim cond3 As Date
filafacturas = 2
filapagos = 2
filasaldo = 11
cond1 = ComboBox1.Value
cond2 = TextBox1.Value
cond3 = TextBox2.Value
‘Realiza el bucle en la hoja dbcomp en busca de facturas mietras no haya filas vacias
‘Busca facturas según datos ingresados
While Sheets(«dbcomp»).Cells(filafacturas, 1) <> Empty
dato1 = Sheets(«dbcomp»).Cells(filafacturas, 3).Value
dato2 = Sheets(«dbcomp»).Cells(filafacturas, 1).Value
dato3 = Sheets(«dbcomp»).Cells(filafacturas, 1).Value
dato4 = Sheets(«dbcomp»).Cells(filafacturas, 4).Value
dato5 = Sheets(«dbcomp»).Cells(filafacturas, 13).Value
If dato1 = cond1 And _
dato2 >= cond2 And _
dato3 <= cond3 And _
dato4 <> «NC» And _
dato5 <> «Anulada» Then
‘si los datos coinciden con «factura , proveedor/cliente y las fechas los compia en la hoja saldos
Sheets(«dbcomp»).Cells(filafacturas, 1).Copy Destination:=Sheets(«saldo»).Cells(filasaldo, 3)
Sheets(«dbcomp»).Cells(filafacturas, 4).Copy Destination:=Sheets(«saldo»).Cells(filasaldo, 4)
concepto1 = Sheets(«dbcomp»).Cells(filafacturas, 5)
concepto2 = Sheets(«dbcomp»).Cells(filafacturas, 6)
concepto3 = Sheets(«dbcomp»).Cells(filafacturas, 7)
Sheets(«saldo»).Cells(filasaldo, 4) = Range(«d» & filasaldo) & » » & concepto1 & » » & concepto2 & » » & concepto3
Sheets(«dbcomp»).Cells(filafacturas, 8).Copy Destination:=Sheets(«saldo»).Cells(filasaldo, 6)
Sheets(«dbcomp»).Cells(filafacturas, 19).Copy Destination:=Sheets(«saldo»).Cells(filasaldo, 8)
filafacturas = filafacturas + 1
filasaldo = filasaldo + 1
Else
filafacturas = filafacturas + 1
End If
Wend
‘Realiza bucle en la hoja dbcomp buscando pagos para realizar las comparaciones y extraer datos coincidentes
‘Busca pagos según datos ingresados
While Sheets(«dbcomp»).Cells(filapagos, 1) <> Empty
dato1 = Sheets(«dbcomp»).Cells(filapagos, 3).Value
dato2 = Sheets(«dbcomp»).Cells(filapagos, 1).Value
dato3 = Sheets(«dbcomp»).Cells(filapagos, 1).Value
dato4 = Sheets(«dbcomp»).Cells(filapagos, 4).Value
dato6 = Sheets(«dbcomp»).Cells(filapagos, 13).Value
If dato1 = cond1 And _
dato2 >= cond2 And _
dato3 <= cond3 And _
dato4 <> «NC» And _
dato6 = «Cancelada» Then
‘si los datos coinciden con el proveedor y las fechas los copia en la hoja saldos
Sheets(«dbcomp»).Cells(filapagos, 1).Copy Destination:=Sheets(«saldo»).Cells(filasaldo, 3)
Sheets(«dbcomp»).Cells(filapagos, 10).Copy Destination:=Sheets(«saldo»).Cells(filasaldo, 4)
Sheets(«saldo»).Cells(filasaldo, 4) = «Orden de Pago Nº » & Range(«d» & filasaldo)
Sheets(«dbcomp»).Cells(filapagos, 8).Copy Destination:=Sheets(«saldo»).Cells(filasaldo, 5)
Sheets(«dbcomp»).Cells(filapagos, 19).Copy Destination:=Sheets(«saldo»).Cells(filasaldo, 8)
filapagos = filapagos + 1
filasaldo = filasaldo + 1
Else
filapagos = filapagos + 1
End If
Wend
‘Ordena por fecha en forma ascendente y por concepto todo lo que parezca número
Sheets(«saldo»).Select
Range(«C11:h65500»).Sort Key1:=Range(«C11»), Order1:=xlAscending, Key2:=Range(«D11»), _
Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortNormal
‘Hace que la fecha del saldo inicial sea igual a la del primer dato
Sheets(«saldo»).Range(«c10») = TextBox1 ‘Sheets(«saldo»).Range(«c11»)
Sheets(«saldo»).Range(«d10») = «SALDO INICIAL AL: » & Range(«c10»)
‘Por último calcula el saldo en cada celda
Dim filsaldito As String
Dim filfecha As String
Dim saldito As Single
filfecha = 11
filsaldito = 10
‘Recorre todas las filas de la hoja saldo mientras no este vacia
While Sheets(«saldo»).Cells(filfecha, 3) <> Empty
Sheets(«saldo»).Cells(filfecha, 7).Value = Sheets(«saldo»).Cells(filsaldito, 7).Value + Sheets(«saldo»).Cells(filfecha, 6).Value – Sheets(«saldo»).Cells(filfecha, 5).Value
filfecha = filfecha + 1
filsaldito = filsaldito + 1
Wend
‘Este procedimiento hace colocar el saldo en la celda f6 a modo resumen
Sheets(«saldo»).Cells(7, 6).Value = Sheets(«saldo»).Cells(filsaldito, 7).Value + Sheets(«saldo»).Cells(filfecha, 6).Value – Sheets(«saldo»).Cells(filfecha, 5).Value
‘ejecuta la rutina que le da formato a las celdas
FormatoCeldasSaldo
‘Se posiciona la vista de la hoja en la fila 7
ActiveWindow.ScrollRow = 7
‘oculta el formulario en el que se ingresa el saldo a buscar
Unload Me
‘Se oculta también lo hoja cancela op , porque el saldo puede ser consuldado desde ahí
‘Sheets(«cancela oP»).Visible = xlVeryHidden
‘Sheets(«dbcomp»).Visible = xlVeryHidden
Sheets(«saldo»).Protect Password:=»1111″
Sheets(«saldo»).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub textbox3_AfterUpdate()
Dim quebusco As String
Dim rangoabuscar As String
Dim busca As Object
On Error Resume Next
rangoabuscar = «a2:a10000»
quebusco = TextBox3.Text
Set busca = Sheets(«Proveedores»).Range(rangoabuscar).Find(quebusco, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing Then
ComboBox1 = busca.Offset(0, 1)
Else
MsgBox «No existe Proveedores o la cuenta esta mal ingresada» & Chr(«saldo») & » Ingrese en formato 00000, ej. 00010, 01020″, vbCritical
TextBox3.SetFocus
Exit Sub
End If
End Sub
Private Sub UserForm_Activate()
Application.ScreenUpdating = False
Sheets(«proveedores»).Activate
Range(«b2»).Select
Do While ActiveCell <> Empty
ComboBox1.AddItem ActiveCell
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Código que se introduce en módulo
Sub muestrauserform5()
Load UserForm5
UserForm5.Show
End Sub
UN CAFÉ y de esta manera ayudar a seguir
manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.
.
helpful INVITE ME A COFFEE and so help keep
up the page, CLICK to download free example.
Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends