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
1

Envíame un correo nuevo con el archivo y en la hoja Resumen, me pones un ejemplo de cómo quieres ver la consulta de todos los artículos. R ecuerda poner tu nombre en el asunto.

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 Sub

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas