Como invocar movimientos de todos los artículos de una planilla inventario hecho en excel vba con rango de fechas
Quería consultarte como puedo reportar todos los artículos que tengo en una planilla excel o sea tengo mi base de datos de movimientos en excel lo que quisiera reportar es por ejemplo si quiero reportar todas las entradas, salidas, devoluciones, etc de todos los artículos que tengo invetariado por rango de fechas tildando una casilla de verificación que diga "todos los artículos" y que el texto "todos los artículos" se traspase en una hoja de reporte en excel, si me podrías asesorar por favor con algún userform o combobox.
1 Respuesta
Respuesta de Dante Amor
1
Te anexo las macros
Private Sub CheckBox1_Click()
'Por.Dante Amor
TextBox1.Enabled = True
TextBox2.Enabled = True
If CheckBox1 Then
TextBox1.Enabled = False
TextBox2.Enabled = False
End If
End Sub
'
Private Sub CommandButton1_Click()
'Por.Dante Amor
Set h1 = Sheets("RESUMEN")
Set h2 = Sheets("INVENT")
'
'limpiar hoja
h1.Range("A9:G" & Rows.Count).ClearContents
If CheckBox1 = False Then
Call UnArticulo(h1, h2)
Else
Call Todos(h1, h2)
End If
End Sub
'
Sub Todos(h1, h2)
'Por.Dante Amor
If TextBox3 = "" Then
fechas = ""
Else
fechas = "1"
If Not IsDate(TextBox3) Then
MsgBox "La fecha inicial no es correcta"
Exit Sub
End If
If Not IsDate(TextBox4) Then
MsgBox "La fecha final no es correcta"
Exit Sub
End If
fecini = CDate(TextBox3)
fecfin = CDate(TextBox4)
End If
'
Application.ScreenUpdating = False
'
'Poner datos:
h1.[B3] = "Todos"
h1.[D3] = "Todos"
h1.[B5] = fecini
h1.[D5] = fecfin
'
fila = 9
For Each h3 In Sheets
If h3.[B13] = "FECHA" Then
u3 = h3.Range("B" & Rows.Count).End(xlUp).Row
If u3 > 13 Then
h1.Cells(fila, "A") = h3.Cells(14, "L")
h1.Cells(fila, "F") = h3.Cells(u3, "M")
nombre = h3.Name
For i = 15 To u3
If fechas = "" Then
fecini = h3.Cells(i, "B")
fecfin = h3.Cells(i, "B")
End If
If h3.Cells(i, "B") >= fecini And h3.Cells(i, "B") <= fecfin Then
Select Case LCase(Left(h3.Cells(i, "C"), 3))
Case "com"
cantidad = h3.Cells(i, "F")
h1.Cells(fila, "B") = h1.Cells(fila, "B") + cantidad
Case "ven"
cantidad = h3.Cells(i, "I")
h1.Cells(fila, "C") = h1.Cells(fila, "C") + cantidad
Case "dev"
cantidad = h3.Cells(i, "F") * -1
h1.Cells(fila, "D") = h1.Cells(fila, "D") + cantidad
End Select
h1.Cells(fila, "E").FormulaR1C1 = "=RC[-4]+RC[-3]-RC[-2]-RC[-1]"
h1.Cells(fila, "G").FormulaR1C1 = "=RC[-1]*RC[-2]"
End If
Next
fila = fila + 1
End If
End If
Next
Application.ScreenUpdating = True
End Sub
'
Sub UnArticulo(h1, h2)
'Por.Dante Amor
If TextBox1 = "" And TextBox2 = "" Then
MsgBox "Entra un Código o un Artículo"
Exit Sub
End If
'
If TextBox1 <> "" Then
cve = TextBox1
col = "B"
Else
cve = TextBox2
col = "C"
End If
If IsNumeric(cve) Then cve = Val(cve)
'
Set b = h2.Columns(col).Find(cve, lookat:=xlWhole, LookIn:=xlValues)
If b Is Nothing Then
MsgBox "No existe el dato : " & cve
Exit Sub
End If
'
cod = h2.Cells(b.Row, "B")
art = h2.Cells(b.Row, "C")
'
existe = False
For Each h In Sheets
If LCase(h.Name) = LCase(cod) Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "No existe la hoja: " & cod
Exit Sub
End If
'
If TextBox3 = "" Then
fechas = ""
Else
fechas = "1"
If Not IsDate(TextBox3) Then
MsgBox "La fecha inicial no es correcta"
Exit Sub
End If
If Not IsDate(TextBox4) Then
MsgBox "La fecha final no es correcta"
Exit Sub
End If
fecini = CDate(TextBox3)
fecfin = CDate(TextBox4)
End If
'
Application.ScreenUpdating = False
'
Set h3 = Sheets("" & cod)
'Poner datos:
h1.[B3] = cod
h1.[D3] = art
h1.[B5] = fecini
h1.[D5] = fecfin
'
fila = 9
h1.Cells(fila, "A") = h3.Cells(14, "L")
u3 = h3.Range("B" & Rows.Count).End(xlUp).Row
h1.Cells(fila, "F") = h3.Cells(u3, "M")
For i = 15 To u3
If fechas = "" Then
fecini = h3.Cells(i, "B")
fecfin = h3.Cells(i, "B")
End If
If h3.Cells(i, "B") >= fecini And h3.Cells(i, "B") <= fecfin Then
Select Case LCase(Left(h3.Cells(i, "C"), 3))
Case "com"
cantidad = h3.Cells(i, "F")
h1.Cells(fila, "B") = h1.Cells(fila, "B") + cantidad
Case "ven"
cantidad = h3.Cells(i, "I")
h1.Cells(fila, "C") = h1.Cells(fila, "C") + cantidad
Case "dev"
cantidad = h3.Cells(i, "F") * -1
h1.Cells(fila, "D") = h1.Cells(fila, "D") + cantidad
End Select
h1.Cells(fila, "E").FormulaR1C1 = "=RC[-4]+RC[-3]-RC[-2]-RC[-1]"
h1.Cells(fila, "G").FormulaR1C1 = "=RC[-1]*RC[-2]"
End If
Next
'
Application.ScreenUpdating = True
End Subsal u dos
