ComboBox y ListBox en excel

No se si estaré bien ubicado con mi pregunta.
Tengo este código que un experto ya trató de ayudarme. A pesar de su voluntad y ganas de ayuda, no fue posible llegar a un termino positivo y el experto tuvo que descartar mi pregunta. Código
Private Sub UserForm_Initialize()
'ComboPrinte.clear   pero no me sirvio
Application.ScreenUpdating = False
'Llenar ComboBox
Dim oSheet As Object
With Printe.ComboPrinte
'recorremos las hojas del conjunto HOJAS
    For Each oSheet In Sheets
'verificamos que el objeto se trata de una hoja u hoja Gráfico
    If TypeName(oSheet) = "Worksheet" Or TypeName(oSheet) = "Chart" Then
'si lo es, agregamos a la lista
    .AddItem oSheet.Name 'Hasta aqui ComboPrinte
End If
'Llenar ListBox
    ActiveSheet.Select 'Selección de la hoja activa
    Cells(2, 1).Select
    pepe = Range("A65536").End(xlUp).Row 'Dá rango de lineas para relleno del ListBox
    ListPrinte.RowSource = "A2:i" & pepe 'Dá rango de columnas para relleno del ListBox
    ListPrinte.ColumnWidths = "110;90;30;46;30;46;30;46;120" 'ancho de columnas del ListBox
    ListPrinte.ColumnCount = 9  'Cantidad columnas del ListBox
    Next
  End With
Application.ScreenUpdating = True
End Sub
Llena un ListBox y un ComboBox
 y este
Private Sub ComboPrinte_Change()
Application.ScreenUpdating = False
    Sheets(ComboPrinte.Text).Select
    UserForm_Initialize 'inicia codigo de inicio del formulario para el ListBox
Application.ScreenUpdating = True
End Sub 
Esto para seleccionar una hoja y llenar el ListBox con los datos de la hoja seleccionada en el combo, PROBLEMA;
Cuando selecciono una hoja en el combobox, se llena el Listbox con los datos de la hoja seleccionada, PERFECTO pero, en el combobox se van duplicando los nombres de las hojas, si selecciono segunda ves, se triplican los nombres, vuelvo a seleccionar otra, quedan cuatriplican los nombres y así sucesivamente, de selección en selección se me duplican los nombres de las hojas en el combobox.
Ya le metí un ComboPrinte. Clear al inicio del código pero no me sirvió
¿Dónde tengo el problema y como solucionarlo?

1 respuesta

Respuesta
1
Prueba con este código. Está basado en el anterior pero... a mi me gusta más y evita el problema que comentas.
Un saludo
Option Explicit
Private Sub comboPrinte_Change()
    Application.ScreenUpdating = False
    If comboPrinte.Text <> "" Then
        On Error Resume Next
        Sheets(comboPrinte.Text).Select
        On Error GoTo 0
    End If
    actualizaDatosComboYLista ' Actualiza los datos
    Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
    actualizaDatosComboYLista
End Sub
Private Sub actualizaDatosComboYLista()
    Dim pepe
    Dim aux As String
    Dim i As Integer
    Application.ScreenUpdating = False
    ' Si el combo no tiene tantas entradas como páginas el libro... lo actualizamos
    If comboPrinte.ListCount <> ThisWorkbook.Sheets.Count Then
        ' Inicializamos la lista de hojas
        aux = comboPrinte.Text
        comboPrinte.Clear
        For i = 1 To ThisWorkbook.Sheets.Count
            ' agregamos a la lista
            comboPrinte.AddItem ThisWorkbook.Sheets(i).Name
        Next
        If Trim$(aux) <> "" Then comboPrinte.Text = aux Else comboPrinte = ActiveSheet.Name
        Exit Sub
    End If
    'Llenar ListBox
    Cells(2, 1).Select
    If Trim$(comboPrinte.Text) <> ActiveSheet.Name Then
        ListPrinte.RowSource = ""
      Else
        aux = Range("A65536").End(xlUp).Row 'Dá rango de lineas para relleno del ListBox
        ListPrinte.RowSource = "A2:i" & Trim$(aux) 'Dá rango de columnas para relleno del ListBox
        ListPrinte.ColumnWidths = "110;90;30;46;30;46;30;46;120" 'ancho de columnas del ListBox
        ListPrinte.ColumnCount = 9  'Cantidad columnas del ListBox
    End If
    Application.ScreenUpdating = True
End Sub
Si, evita  el acumulado de nombres de hojas en el combo pero, existe un problema y es que tengo en el formulario unos botones(4) que 2 son para previa hoja y hoja siguiente y 2 más para ir a la hoja final y primera hoja y estos botones hacen la misma funcion del combo y si le cambio el UserForm_Initialize por este  actualizaDatosComboYLista, el listbox al correr de hoja con los botones no llena el listbox, ahora bien;
¿Tal vez prefieras que te deje un enlace donde bajar el libro?
Son 2 formularios y el que estamos tratando es el formulario Printe, ¿la función? Es seleccionar el contacto y pasarlo a la hoja CopyImpres para luego imprimir en hoja el o los contactos que se necesite imprimir
Preguntaras ¿para qué quiero tantos objetos para seleccionar determinada hoja?
Quiero dar facilidad a las personas(2) que van a trabajar con el libro en la oficina y quiero tener los botones y el combo para la selección de las hojas.
Al terminar el proyecto, trataré de que trabajen con las hojas ocultas y que todo se haga desde los formularios.
Puedo hacer una exposición de la finalidad del proyecto para que tengas una idea si es que prefieras bajar el libro y tenerlo para tu mejor programación, ademas aun le falta algo que más adelante quiero tratar de agregar(cuando esta parte esté lista que es un enlace (hipervínculo) para que al dar dblClick en un numero determinado de teléfono, halla conexión y ligacion al numero solicitado
Entiendo que los 4 botones llamaban al "UserForm_Initialize". Prueba a cambiar esa llamada por "comboPrinte_Change", cambiarla por "actualizaDatosComboYLista" no hace nada ya que es exactamente lo mismo.
Si no te funciona, mándame el código de alguno de los botones y vemos que puede estar pasando.
Como comprenderás, por motivos de seguridad, no acostumbro a descargar hojas de cálculo ni ningún fichero con programación... salvo que lo vea estrictamente necesario.
Ese cambio yo lo probé, esa la trazon por la cual te comenté lo anterior
Código de los botones de movimiento de hojas
Quisiera poder meterle tal como hice en los siguientes, hoja previa y hoja siguiente, un mensaje pero no me lo acepta, siempre me da error
Private Sub cmdPriHoja_Click()  Vá a la primera hoja
Application.ScreenUpdating = False
    ListPrinte.Value = "" 'Limpia el ListBox para recibir los nuevos datos
If Not Sheets(1).Select Then 'Nos desplazamos a la primera hoja
End If
   UserForm_Initialize 'inicia codigo de inicio del formulario para el ListBox
   Application.ScreenUpdating = True
End Sub
------------------------------------------
Quisiera poder meterle tal como hice en los siguientes, hoja previa y hoja siguiente, un mensaje pero no me lo acepta, siempre me da error
Private Sub cmdUltHoja_Click()  'Vá a la ultima hoja
Application.ScreenUpdating = False
    ListPrinte.Value = "" 'Limpia el ListBox para recibir los nuevos datos
    Sheets(Sheets.Count).Select 'Nos desplazamos a la última hoja
    UserForm_Initialize 'inicia codigo de inicio del formulario para el ListBox
Application.ScreenUpdating = True
End Sub
----------------------------
Private Sub cmdSigHoja_Click() 'Vá a la siguiente hoja
Application.ScreenUpdating = False
    ListPrinte.Value = "" 'Limpia el ListBox para recibir los nuevos datos
'Pasamos a la hoja siguiente pero controlamos previamente que haya una hoja detrás de la
'hoja en la que nos encontramos es decir, detrás de la hoja activa.
'Si no estamos en la última hoja...
If ActiveSheet.Name <> Sheets(Sheets.Count).Name Then
'entonces pasamos a la siguiente hoja
ActiveSheet.Next.Select 'Hacia adelante de hoja en hoja
Else
MsgBox "No hay más hojas hacia adelante", vbInformation, " Información"
End If
   UserForm_Initialize
Application.ScreenUpdating = True
End Sub
--------------------------------------------------
Private Sub cmdPrevHoja_Click() 'Vá a previa hoja
Application.ScreenUpdating = False
If ActiveSheet.Name <> Sheets(1).Name Then
    ListPrinte.Value = "" 'Limpia el ListBox para recibir los nuevos datos
        ActiveSheet.Previous.Select  'Hacia anterior hoja
Else
MsgBox "No hay más hojas hacia atrás", vbInformation, " Información"
End If
    UserForm_Initialize 'inicialisa todso los ojectos
Application.ScreenUpdating = True
End Sub
 ---------------------------------------------
Private Sub ComboPrinte_Change()
'On Error Resume Next 'si hay eror que continue
Application.ScreenUpdating = False
nbreHoja = ComboPrinte.Value
Sheets(nbreHoja).Select
'    Sheets(ComboPrinte.Text).Select 'reemplasa las 2 anteriores
    UserForm_Initialize 'inicia codigo de inicio del formulario para el ListBox
Application.ScreenUpdating = True
End Sub
--------------------------------------------
Private Sub ListPrinte_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
'Dim x, y
Sheets(6).Select
    For x = 0 To ListPrinte.ListCount - 1 'Recorremos filas
      If ListPrinte.Selected(x) = True Then 'Si está seleccionado
        y = Sheets("CopyImpres").Range("A" & Rows.Count).End(xlUp)(2).Row
        If y = 1 Then y = 2
         Sheets("CopyImpres").Range(Cells(y, 1), Cells(y, 9)) = _
         Array(ListPrinte.Column(0, x), ListPrinte.Column(1, x), ListPrinte.Column(2, x), _
         ListPrinte.Column(3, x), ListPrinte.Column(4, x), ListPrinte.Column(5, x), _
         ListPrinte.Column(6, x), ListPrinte.Column(7, x), ListPrinte.Column(8, x))
      End If
    Next x
 Application.ScreenUpdating = True
End Sub
----------------------------------------------------
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
'Llenar ComboPrinte
  x = ThisWorkbook.Sheets.Count
        For i = 1 To x
        ComboPrinte.AddItem (Sheets(i).Name)
    Next i
'Llenar ListPrinte
    ActiveSheet.Select 'Selección de la hoja activa
    Cells(2, 1).Select
    pepe = Range("A65536").End(xlUp).Row 'Dá rango de lineas para relleno del ListBox
    ListPrinte.RowSource = "A2:i" & pepe 'Dá rango de columnas para relleno del ListBox
    ListPrinte.ColumnWidths = "110;90;30;46;30;46;30;46;118" 'ancho de columnas del ListBox
    ListPrinte.ColumnCount = 9  'Cantidad columnas del ListBox
Application.ScreenUpdating = True
End Sub
------------------------------------------------
Me parece que en el UserForm_Initialize() es donde está la cosa porque ya vi que cuando le activo esa linea es cuando duplica los nombres en el Combo
Prueba con este código para los botones. A mi me funciona todo bien.
Un saludo
Private Sub cmdPrevHoja_Click()
    Dim i As Integer
    If Me.comboprinte = Me.comboprinte.List(0) Then Beep: Exit Sub
    For i = 0 To Me.comboprinte.ListCount - 1
        If Me.comboprinte = Me.comboprinte.List(i) Then Exit For
    Next i
    Me.comboprinte = Me.comboprinte.List(i - 1)
End Sub
Private Sub cmdPriHoja_Click()
    If Me.comboprinte.ListCount > 0 Then Me.comboprinte = Me.comboprinte.List(0)
End Sub
Private Sub cmdSigHoja_Click()
    Dim i As Integer
    If Me.comboprinte = Me.comboprinte.List(Me.comboprinte.ListCount - 1) Then Beep: Exit Sub
    For i = 0 To Me.comboprinte.ListCount - 1
        If Me.comboprinte = Me.comboprinte.List(i) Then Exit For
    Next i
    Me.comboprinte = Me.comboprinte.List(i + 1)
End Sub
Private Sub cmdUltHoja_Click()
    If Me.comboprinte.ListCount > 0 Then Me.comboprinte = Me.comboprinte.List(Me.comboprinte.ListCount - 1)
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas