2014-08-12

Listar todos los nombres de libro de Excel

Title Para listar los nombres definidos de un libro de Excel usamos el siguiente código. Crea una nueva hoja en la que lista todos los nombres del libro y autoajusta el ancho de las dos columnas.

Creando una nueva hoja

Sub ListarNombres1()

    Dim wks As Worksheet
    Set wks = Worksheets.Add
    wks.Range("A1").ListNames
    wks.Columns("A:B").Columns.AutoFit

End Sub
Más simplificadamente aún:

Sub ListarNombres2()

    Sheets.Add
    Range("A1").ListNames
    Columns("A:B").AutoFit

End Sub

Cuadro de diálogo

Otra opción que he escrito, consiste en elegir mediante un cuadro de diálogo el rango donde queremos que liste los nombres.

Sub ListarNombres3()

    Dim myRange As Range
    Set myRange = Application.InputBox(Prompt:="Selecciona celda vacía", _
    Title:="Listado de nombres", Type:=8)
    myRange.ListNames
    
End Sub
El inconveniente de la macro anterior es que al copiar el listado de nombres, si no sabemos el número de nombres del libro, puede sobreescribir celdas. Para evitarlo he creado el siguiente código. Crea una hoja temporal con el listado de nombres y, a partir de la celda seleccionada, calcula si el rango necesario para copiar los nombres está vacío o no. Si no lo está, no copiará el listado de nombres.

Sub ListarNombres4() 

    Dim sInicial As String
    sInicial = ActiveSheet.Name
    Dim sName As String
    Worksheets.Add.Name = "temp"
    Sheets("temp").Range("A1").ListNames
    Dim i As Integer
    i = [COUNTA(temp!A:A)]
    Sheets(sInicial).Select
    
    On Error GoTo Final
    Dim myRange As Range
    Set myRange = Application.InputBox(Prompt:="Elige celda con" & _
        " región vacía alrededor de 2 columnas por" & i & " filas", _
        Title:="Listado de nombres", Type:=8)
            If RangeIsBlank(myRange.Resize(i, 2)) = False Then
              MsgBox "Rango no vacío. No se puede copiar aquí.", vbCritical
              GoTo Final
              Else
            End If
    myRange.ListNames
    myRange.Resize(i, 2).Columns.AutoFit
    
Final:
        Application.DisplayAlerts = False
        Worksheets("temp").Delete
        Application.DisplayAlerts = True

End Sub
Para emplear la macro anterior es preciso incluir en un módulo del libro la siguiente función de Dick Kusleika.

Function RangeIsBlank(rRng As Range) As Boolean
    
    If IsNull(rRng.FormulaArray) Then
        RangeIsBlank = False
    Else
        RangeIsBlank = Len(rRng.FormulaArray) = 0
    End If
    
End Function

No hay comentarios:

Publicar un comentario

Nube de datos