Edición de macro Excel pasar de OptionButton para ComboBox

James bond

Seguro recuerdas esta

Private Sub cmbBusque_Click()
fecha_inicial = Format(DTPicker1, "mm/dd/yyyy")
fecha_final = Format(DTPicker2, "mm/dd/yyyy")
Set hf = Worksheets("Filtro"): hf.UsedRange.Clear
If OptionButton1 = True Then
COLUMNA = Range("E1").Column
Set HT = Worksheets("Productos").Range("A1").CurrentRegion
End If
If OptionButton2 = True Then
    COLUMNA = Range("D1").Column
    Set HT = Worksheets("Entrada").Range("A1").CurrentRegion
End If
If OptionButton3 = True Then
    COLUMNA = Range("D1").Column
    Set HT = Worksheets("Salida").Range("A1").CurrentRegion
End If
''''
If OptionButton4 = True Then
COLUMNA = Range("E1").Column
Set HT = Worksheets("John Deere").Range("A1").CurrentRegion
End If
If OptionButton5 = True Then
COLUMNA = Range("E1").Column
Set HT = Worksheets("CAT").Range("A1").CurrentRegion
End If
''''
If fecha_inicial > fecha_final Then
    MsgBox ("Se presenta un problema" & Chr(13) _
    & "La fecha inicial es mayor que la fecha final"), vbInformation, "AVISO"
Else
With HT
    On Error Resume Next
    .AutoFilter
    If Err.Number > 0 Then MsgBox ("No ha seleccionado una opcion"), vbInformation, "AVISO": GoTo SALIDA
    On Error GoTo 0
    .AutoFilter Field:=COLUMNA, Criteria1:=">=" & fecha_inicial, Operator:=xlAnd, Criteria2:="<=" & fecha_final
    .SpecialCells(xlCellTypeVisible).Copy Destination:=hf.Range("A1")
    Set AREA = hf.Range("A1").CurrentRegion
    If AREA.Rows.Count = 1 Then
        MsgBox ("No hay registros en ese rango de fechas"), vbInformation, "AVISO"
        ListBox1.RowSource = "": .AutoFilter: txtExistencia.Text = "": GoTo SALIDA
    End If
    Set filtra = hf.Range("a1").CurrentRegion
    Set filtra = filtra.Rows(2).Resize(filtra.Rows.Count, filtra.Columns.Count)
    With ListBox1
        .RowSource = "=Filtro!" & filtra.Address
        .ColumnHeads = True
        .ColumnCount = HT.Columns.Count
        If COLUMNA = 5 Then .ColumnWidths = "55 pt;160 pt;30 pt;75 pt;65 pt;75 pt;220 pt"
        If COLUMNA = 4 Then .ColumnWidths = "55 pt;160 pt;30 pt;65 pt;220 pt"
    End With
    txtExistencia.Text = AREA.Rows.Count - 1
    .AutoFilter
End With
End If
SALIDA:
End Sub

Después de tener que pasar todo a este libro, fue que vi y pensé ¿(y ahora como hago? Hay mas hojas, por ahora 6 ya están pero hay mas esperando

Ya tengo el ComboBox (cboHojas) en el formulario que carga en Initialize los nombres de las Hojas presentes

    cboHojas.List = Array("Productos", "Silverado", "John Deere", "CAT", "Entrada", _
    "Salida", "Selecione Hoja")
    cboHojas.ListIndex = 5 'muestra por default el ítem 5 (ultimo)

Quiero sustituir los optionButton por el Combobox  y enlazar este a los nombres de as hojas porque tendría que agrandar el form para que quepan todos los Option y mas tarde cuando aumente la cantidad de hojas  de 6 a algunas otras que están para trasladar tendría que estar aumentando aun mas y alargando mucho mas esta macro y el Combo me abarca cualquier cantidad de items hojas y se hace mas corta la macro.

1 Respuesta

Respuesta
1

Te dejo una opción mejor a la del array si tienes más hojas tendrás que escribir el nombre en el array mi opción lee las pestañas y las carga en el combobox así lo único que tienes que hacer es crear la hoja y la macro la carga la siguiente vez que la corras, la macro continua siendo la misma solo cambia un poco al principio.

Private Sub CommandButton1_Click()
FECHA_INICIAL = Format(DTPicker1, "mm/dd/yyyy")
FECHA_FINAL = Format(DTPicker2, "mm/dd/yyyy")
Set HF = Worksheets("FILTROS"): HF.UsedRange.Clear: HOJA = cboHojas.Value
If FECHA_INICIAL > FECHA_FINAL Then
    MsgBox ("LA FECHA INICIAL NO PUEDE SER MAYOR A LA FECHA FINAL"), vbInformation, "AVISO"
    GoTo SALIDA
End If
If cboHojas.ListIndex < 0 Then
    MsgBox ("SELECCIONE UNA HOJA"), vbInformation, "AVISO"
    CommandButton1.Caption = ""
    GoTo SALIDA
End If
Set HT = Worksheets(HOJA).Range("a1").CurrentRegion
With HT
    On Error Resume Next
    COLUMNA = WorksheetFunction.Match("FECHA DE INGRESO", .Rows(1), 0)
    If Err.Number > 0 Then
        MsgBox ("ESTA PAGINA NO CONTIENE INFORMACION"), vbInformation, "AVISO"
        CommandButton1.Caption = ""
        GoTo SALIDA
    End If
    On Error GoTo 0
End With
CommandButton1.Caption = ""
If HOJA = cboHojas.ListIndex < 0 Then
    MsgBox ("NO SELECCIONASTE UNA OPCION"), vbInformation, "AVISO"
Else
With HT
    On Error Resume Next
    .AutoFilter
    If Err.Number > 0 Then MsgBox ("no seleccionaste una opcion"), vbInformation, "AVISO": GoTo SALIDA
    On Error GoTo 0
    .AutoFilter Field:=COLUMNA, Criteria1:=">=" & FECHA_INICIAL, Operator:=xlAnd, Criteria2:="<=" & FECHA_FINAL
    .SpecialCells(xlCellTypeVisible).Copy Destination:=HF.Range("A1")
    Set AREA = HF.Range("A1").CurrentRegion
    If AREA.Rows.Count = 1 Then
        MsgBox ("NO HAY REGISTROS EN ESE RANGO DE FECHAS"), vbInformation, "AVISO"
        ListBox1.RowSource = "": .AutoFilter: GoTo SALIDA
    End If
    With ListBox1
        .RowSource = "=FILTROS!" & Range("A1").CurrentRegion.Address
        .ColumnHeads = False
        .ColumnCount = HT.Columns.Count
        If COLUMNA = 5 Then .ColumnWidths = "65;200;20;65;60;40;300"
        If COLUMNA = 4 Then .ColumnWidths = "65;200;20;60;300"
         CommandButton1.Caption = AREA.Rows.Count - 1
    End With
    .AutoFilter
End With
End If
SALIDA:
End Sub
Private Sub UserForm_Initialize()
For Each hojas In Worksheets
    nombre = hojas.Name:  cboHojas.AddItem nombre
Next hojas
End Sub

Veo algo en la macro que me dejas que me parecer ser la antigua, no la ultima que me dejaste de la otra pregunta.

Esta es la que te deje, repara bien, porque algunas lineas tienen False y esta es true como

 .ColumnHeads = False

Quisiera pedirte que hicieras la edición a la que te deje arriba.

No quiero que te molestes, es para ser más directo una ves que esa está funcionando bien, hasta ahora

Haga lo que haga, no pasa del

        MsgBox ("ESTA PAGINA NO CONTIENE INFORMACION"), vbInformation, "AVISO"

No entiendo que paso que la macro que pegaste en este post no funciono en mi maquina y al decir no funciono quiero decir que las fechas hiciera lo que hiciera no las reconocía y me regresaba al formulario.

Ya la arregle y el problema no fue la programación que te envíe, puse las líneas que tu solicistaste y dio el mismo problema.

Por cierto si cambias el nombre de la hoja por decir productos por producto debes hacer el cambio en el código en al array porque si no la macro te marcara errores, prueba a ver que más sale.

Private Sub cmbBusque_Click()
FECHA_INICIAL = Format(DTPicker1, "mm/dd/yyyy")
FECHA_FINAL = Format(DTPicker2, "mm/dd/yyyy")
Set HF = Worksheets("FILTRO"): HF.UsedRange.Clear: HOJA = cboHojas.Value
If FECHA_INICIAL >= FECHA_FINAL Then
    MsgBox ("LA FECHA INICIAL NO PUEDE SER MAYOR" _
    & Chr(13) & "O IGUAL A LA FECHA FINAL"), vbInformation, "AVISO"
    cmbBusque.Caption = ""
    txtExistencia.Text = Empty
    GoTo SALIDA
End If
HOJA = cboHojas.Value
On Error Resume Next
Set HT = Worksheets(HOJA).Range("A1").CurrentRegion
If Err.Number > 0 Then
    MsgBox ("LA HOJA SELECCIONADA NO EXISTE"), vbInformation, "AVISO"
    txtExistencia.Text = Empty
    GoTo SALIDA:
End If
On Error GoTo 0
With HT
On Error Resume Next
COLUMNA = WorksheetFunction.Match("FECHA DE INGRESO", .Rows(1), 0)
If Err.Number > 0 Then
MsgBox ("NO EXISTE INFORMACION EN ESA PAGINA"), vbInformation, "AVISO"
txtExistencia.Text = Empty
GoTo SALIDA:
End If
On Error GoTo 0
    .AutoFilter
    .AutoFilter Field:=COLUMNA, Criteria1:=">=" & FECHA_INICIAL, Operator:=xlAnd, Criteria2:="<=" & FECHA_FINAL
    .SpecialCells(xlCellTypeVisible).Copy Destination:=HF.Range("A1")
    Set AREA = HF.Range("A1").CurrentRegion
    If AREA.Rows.Count = 1 Then
        MsgBox ("No hay registros en ese rango de fechas"), vbInformation, "AVISO"
        ListBox1.RowSource = "": .AutoFilter: txtExistencia.Text = "": GoTo SALIDA
    End If
    Set filtra = HF.Range("a1").CurrentRegion
    Set filtra = filtra.Rows(2).Resize(filtra.Rows.Count, filtra.Columns.Count)
    With ListBox1
        .RowSource = "=Filtro!" & filtra.Address
        .ColumnHeads = True
        .ColumnCount = HT.Columns.Count
        If COLUMNA = 5 Then .ColumnWidths = "55 pt;160 pt;30 pt;75 pt;65 pt;75 pt;220 pt"
        If COLUMNA = 4 Then .ColumnWidths = "55 pt;160 pt;30 pt;65 pt;220 pt"
    End With
    txtExistencia.Text = AREA.Rows.Count - 1
    .AutoFilter
End With
SALIDA:
End Sub
Private Sub UserForm_Initialize()
 With cboHojas
    .List = Array("Productos", "Silverado", "John Deere", "CAT", "Entrada", _
    "Salida", "Selecione Hoja")
    .ListIndex = 5 'muestra por default el ítem 5 (ultimo)
End With
End Sub

Cada macro que me dejabas, eso hacia; era corrigir el nombre de hojas tales como de Productos que la colocabas Producto y Filtros a Filtro porque así están en el libro.

Gracias por tu tiempo James

Tengo que dejarte unas capturas que se ve que si hay información en la hoja y también que la fecha inicial es menor a la final, pasa que aquí la macro esta verificando es el año y no la fecha en su total porque le coloque la fecha y el mismo año a los 2 y solo decía que no hay información.

Lo otro es que al seleccionar la hoja en el combo, no capta los datos de la hoja seleccionada en el combo.

Lo abrí desde la hoja Inicio y luego al ver las fallas, cree un button en la hoja Productos para abrir desde ahí el formulario, pero sin embargo, nada de nada

Dice lo mismo en cualquier de las hojas

Hay un problema con los dtpicker, funcionan para hacer el filtrado pero fallan para hacer la comparación if porque esta comparando textos, no se porque estas fallas se presentan en tu maquina si aquí corre bien la macro, supongo que ha de ser algo que tienes diferente en la configuración de excel esta es la solución que te propongo.

Te envío una pantalla con condiciones similares (no iguales) a la de tu ejemplo y en la segunda pantalla haz los cambios que hay te pongo.

Verifica además la columna fecha todos los campos deben estar en formato fecha puede haber uno o dos en formato texto.

Desisto. Igual. Con los Option si funciona, aunque otra falla tiene aunque con los Option. Tengo el Office 2016

¿Te envío mi libro? Si, si dejame tu mail

Pásame tu email yo tengo el 2007 32 bits

Lo que se necesita es que tu recibas mi libro para ver, si puedes y tienes tiempo para hacerlo en mi libro.  [email protected]

Probé cambiando los DTpicker por TextBox y da lo mismo

Ya vi tu archivo y siento decirte que tienes muy revuelto el código, en el initialize el combobox es cargado de dos maneras, una que similar a la que yo te envíe y la otra como tu la querías.

En cuanto al código que nos ocupa el problema esta en que la macro busca en los títulos de la página que seleccionas en el combobox la palabra fecha ingreso para fijar la columna de las fechas, en tus encabezados aparece Fecha ing, fecha entrada por eso al no encontrarla te pone el mensaje de error no hay información en la hoja.

También tienes líneas como txtexistencias.txt que no existe el objeto en el formulario, donde por cierto tienes demasiados textbox que no tiene utilidad.

Te envío la macro arreglada en el transcurso del día, por lo pronto te envío una imagen del archivo que me mandaste solo para mostrarte que funciona después de las correcciones que le hice.

Hola james.

Como te haz dado cuenta, muchas y muchas macros fueron construidas por el amigo Dante.

Lo del initialize es que verifica si la hoja Filtro existe, si no existe la cría si si no, ñla misma esta en el Thisworkbook. NO estoy diciendo que la pondré

Los DTpicker si no tiene la linea     DTPicker1.Value = Date: DTPicker2.Value = Date

En initialize, no presenta la fecha actual, si no otra.

La fecha (titulo) en la hoja Salida NO puede ser de titulo Fecha Ingr si no de Fecha Salida, ¿cómo hago? Porque sin titulo Fecha Ingr no me funciona en esa hoja. Pregunto si ¿no se puede hacer a que busque a partir de línea 2 y no de la 1?. A que textBox te refieres porque solo existe uno en el formulario.

Funciona si, sol oel inconveniente del titulo en la hoja Salidas que no puede ser Fecha Ingr porque no es ingreso, es salida. ¿Se puede arreglar?

Dejame ver como lo arreglo otra cosa que acabo de notar es que hay una macro que al cerrar el archivo borra la hoja filtro y cuando abres el archivo y corres de nuevo la macro la falta de esta hoja ocasiona que la macro no funcione, ¿quieres quitar o dejar esa línea? ¿O más bien que ventajas o desventajas tienes al dejar esa hoja permanentemente?

Si, pues para no quedar en el libro generando peso, al abrirlo vuelve a crear la hoja Filtro

Checa tu email te envíe el archivo con los cambios con esto supongo que la macro ya funciona

Bueno, pise donde no debía:

Si la vuelve a creer al abrir el libro porque está en el Workbook_Open

Dejala, elimina al cerrar y cría al abrir el libro

Question de gusto al no quererla cuando cerrado, incluso en algunos eventos esta para que limpie totalmente dicha hoja para que mientras el libro abierto, no este cargada de datos que al no usar la hoja, no hacen falta, inclusoi si verificas en el form frmProd está para criar al abrir libro y eliminar al cerrar.

Podría tenerla SOLO en el evento Workbook_Open y Workbook_BeforeClose pero su criador me dijo que era bueno tenerla en los 2 eventos; Workbook_Open y Initialize del form para que se verifiquen si existe o no la hoja, la que detecte que no existe, la cría

De hecho deje las instrucciones de borrar y crear, en los eventos open y close, la quite de Initialize para no tener código duplicado que al final hacen algo lenta la macro.

La pregunta no admite más respuestas

Más respuestas relacionadas