Como actualizar y seleccionar una hoja de excel en un combobox
Mi duda surge de lo siguiente:
Tengo un libro de excel el cual carga reporte, cada que carga reporte nuevo, lo guarda con un nombre diferente. Estas hojas puedo seleccionarlas mediante un combobox para que me lo muestre en Hoja Actividades y hoja Departamentos. Mi problema es que al momento de seleccionar una, esta tarda en cargar y hace que mi macro no sea lo suficientemente ágil para su uso. Otro de los problemas que se me presenta, es que mi combobox no se actualiza cuando agrego un reporte nuevo, tengo que cerrar y volver abrir para poder visualizar todas las hojas que tiene mi libro.
Espero puedan ayudarme
El combobox lo necesito solo en la hoja actividades, ya que de ahi mandare llamar la info de las otras hojas.
Porque entonces no se tiene que copiar toda la hoja, solamente que se cree una hoja nueva con la información del archivo que se está cargando, bueno lo reviso para ajustar la macro y reducir los tiempos.
Si, lo que falta es que me actualice la lista del combibox icuando agrego una hoja nueva, porque no lo actualiza je je
Te anexo el nuevo código para cargar la hoja de avances
Sub CargarReporte()
'Por.Dante Amor
Application.ScreenUpdating = False
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("AVANCE DE ACTIVIDADES")
Set h2 = l1.Sheets("AVANCE POR DEPARTAMENTOS")
Set h3 = l1.Sheets("frm 1")
Set h4 = l1.Sheets("frm 2")
'
arch = Application.GetOpenFilename("Hoja Excel , *.xls*", , "Seleccione el archivo para copiar sus datos.")
If arch = False Then Exit Sub
Set l2 = Workbooks.Open(Filename:=arch) 'Abrir el archivo para copiar
Set h6 = l2.ActiveSheet
'
nrox = InputBox("Escriba el numero de Dia", "SOLICITUD")
If nrox < 1 Or nrox > 31 Then
werr = "No es un nro valido."
End If
For Each h In l1.Sheets
If h.Name = "Dia " & nrox Then
werr = "No es un nro valido."
Exit For
End If
Next
If werr = "No es un nro valido." Then
MsgBox werr
l2.Close
Exit Sub
End If
'
Set h5 = l1.Sheets.Add(after:=l1.Sheets(l1.Sheets.Count))
h5.Name = "Dia " & nrox
'
H1. Cells. Clear
H2. Cells. Clear
'
u6 = h6.Range("A" & Rows.Count).End(xlUp).Row
h6.Range("A5:O" & u6).Copy h1.Range("A8")
H6.Range("A5:O" & u6). Copy h2. Range("A8")
H6.Range("A5:O" & u6). Copy h5. Range("A8")
'
L2. Close
'
macro_formato_seleccion
'
CargaCombo
'
Sheets("AVANCE DE ACTIVIDADES").Select
Application.ScreenUpdating = True
MsgBox "Proceso terminado", vbInformation
End SubPara cargar el combo
Sub CargaCombo()
'Por.Dante Amor
Sheets("AVANCE DE ACTIVIDADES").ComboBox1.Clear
For Each h In Sheets
If Left(h.Name, 3) = "Dia" Then
Sheets("AVANCE DE ACTIVIDADES").ComboBox1.AddItem h.Name
End If
Next
End SubY para formatear las hojas
Sub macro_formato_seleccion()
'Act.Por.Dante Amor
'Hoja Actividades
Call pasos1
'Hoja Departamentos
Call pasos2
End Sub
Sub pasos1()
'Por.Dante Amor
Set h1 = Sheets("AVANCE DE ACTIVIDADES")
Set h2 = Sheets("AVANCE POR DEPARTAMENTOS")
Set h3 = Sheets("frm 1")
Set h4 = Sheets("frm 2")
h1.Range("A:F,H:H,J:J").Delete Shift:=xlToLeft
h3.Rows("1:7").Copy h1.[A1]
ActiveWindow.DisplayGridlines = False
h1.Cells.EntireColumn.AutoFit
u1 = h1.Range("G" & Rows.Count).End(xlUp).Row
With h1.Range("A7:G" & u1)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlThin
End With
Sheets("AVANCE DE ACTIVIDADES").Select
For i = Range("C" & Rows.Count).End(xlUp).Row To 8 Step -1
If Cells(i, "A") = "" And Cells(i, "B") = "" Then
'Eliminar Filas en blanco
Rows(i).Delete
Else
'Eliminar Valores de C a G
If Cells(i, "A") <> "" And Cells(i, "B") = "" Then
Range(Cells(i, 3), Cells(i, 7)).ClearContents
Else
'Comparacion para poner en rojo
If Cells(i, 6) > Cells(i, 7) Then
Range(Cells(i, 6), Cells(i, 7)).Interior.ColorIndex = 3
End If
End If
End If
Next
End Sub
Sub pasos2()
'Act.Por.Dante Amor
Set h1 = Sheets("AVANCE DE ACTIVIDADES")
Set h2 = Sheets("AVANCE POR DEPARTAMENTOS")
Set h3 = Sheets("frm 1")
Set h4 = Sheets("frm 2")
h2.Range("A:B,F:J").Delete Shift:=xlToLeft
Sheets("AVANCE POR DEPARTAMENTOS").Select
u = Range("D" & Rows.Count).End(xlUp).Row
Range("A8:H8").AutoFilter
ActiveSheet.Range("A8:H" & u).AutoFilter Field:=2, Criteria1:="="
ActiveSheet.Range("A8:H" & u).AutoFilter Field:=3, Criteria1:="="
Rows("9:" & u).Delete Shift:=xlUp
Range("A8:H8").AutoFilter
u = Range("D" & Rows.Count).End(xlUp).Row
For i = 8 To Range("D" & Rows.Count).End(xlUp).Row
If Cells(i, "B") <> "" Then Cells(i, "A") = Cells(i, "B")
If Cells(i, "C") <> "" Then Cells(i, "A") = Cells(i, "C")
If Cells(i, 7) > Cells(i, 8) Then
Range(Cells(i, 7), Cells(i, 8)).Interior.ColorIndex = 3
End If
Next
Columns("B:C").Delete Shift:=xlToLeft
h4.Rows("1:7").Copy h2.[A1]
h2.Cells.EntireColumn.AutoFit
u2 = h2.Range("F" & Rows.Count).End(xlUp).Row
With h2.Range("A7:F" & u2)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End SubSaludos. Dante Amor
Recuerda valorar la respuesta.
Es usted un genio... :)
solo me urge una ultima pregunta...Las hojas frm1 y frm2 se pueden ocultar y seguir trabajando igual? o necesitan esta mostradas?
Si se pueden ocultar y trabaja igual
