Nombre de una hoja sea el valor de una Celda o varias

.14/09/16

Buenas tardes, Félix

El siguiente procedimiento hace lo que solicitas.

Pero además, permite que indiques alguna hoja que NO debe ser renombrada y controla que el nombre a asignar sea válido (caracteres especiales o nombres muy extensos o duplicados podrían hacer fracasar la tarea).

Accede al Editor de VBA (Atajo: Alt + F11), inserta un módulo - si no tuvieras uno ya- y pega el siguiente código:

Sub NombraHojas()
'---- Variables modificables:
'=== FELIX: Modifica estos datos de acuerdo a tu planilla:
NombreEn = "D2" ' celda donde está el nombre a dar a la hoja
Excluir = "RESUMEN" ' si hubiera alguna hoja que no debería renombrarse
'---- fin Variables
'
'---- inicio de rutina:
'  
For Each Hoja In Sheets
    If Hoja.Name <> Excluir Then
    NomHoja = Hoja.Range(NombreEn).Value
    On Error Resume Next
    Hoja.Name = NomHoja
    If Err <> 0 Then
            ElMensaje = "La hoja actual no puede tomar el nombre" & Chr(10) & _
            IIf(Len(NomHoja), NomHoja, "<<está vacía!>>") & Chr(10) & "Modifiquelo en celda y relance esta macro" & Chr(10) & " Se interrumpe esta macro" & Chr(10)
            TipoMens = vbCritical
            ElTitulo = "NOMBRE INCOMPATIBLE!"
            MsgBox ElMensaje, TipoMens, ElTitulo
            GoTo TheEnd
    Else
        cont = cont + 1
    End If
    Err.Clear
    On Error GoTo 0
    End If
Next
TheEnd:
    ElMensaje = IIf(cont = 0, "NO SE CAMBIO NINGUN NOMBRE DE HOJA", "Se renombraron: " & cont)
    TipoMens = IIf(cont = 0, vbCritical, vbInformation)
    ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
    MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Bien, nota que al principio de la rutina hay un par de variables para que le indiques de qué celda tomar el nombre y qué hoja quisieras que no se renombre...

.

Una cosa más si no es molestia. Debido a que la información me viene en la celda con la palabra Nombre escrito, tengo que hacer un extraer "=EXTRAE(A4, 9,40)" y pegarlo en todas las hojas para que la fórmula que me envió tome el valor de esta celda y por ultimo tengo que ponerlo en orden Alfabético ascendente.

Tendrá algo que sea más automático, y gracias por toda su ayuda. Es un pro en esto.

.

Hola, Félix

Te armé esta variante -porque no la tenía- que evita que tengas que modificar esas celdas manualmente.

La rutina contempla quitar lo que está delante del nombre y, una vez completado el proceso de renombrado de hojas, las ordena:

Sub NombraHojas()
'---- Variables modificables:
'=== FELIX: Modifica estos datos de acuerdo a tu planilla:  
NombreEn = "D2" ' celda donde está el nombre a dar a la hoja  
Quitar = "Nombre:"  
Excluir = "RESUMEN" ' si hubiera alguna hoja que no debería renombrarse  
'---- fin Variables
'
'---- inicio de rutina:
'  
Application.ScreenUpdating = False
For Each Hoja In Sheets
     If Hoja.Name <> Excluir Then
    NomHoja = Trim(Hoja.Range(NombreEn).Value)
    On Error Resume Next
    Hoja.Name = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar)))
    If Err <> 0 Then
            NomHoja = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar)))
            ElMensaje = "La hoja actual no puede tomar el nombre" & Chr(10) & _
            IIf(Len(NomHoja), NomHoja, "<<está vacía!>>") & Chr(10) & "Modifiquelo en celda y relance esta macro" & Chr(10) & " Se interrumpe esta macro" & Chr(10)
            TipoMens = vbCritical
            ElTitulo = "NOMBRE INCOMPATIBLE!"
            Application.ScreenUpdating = True
            MsgBox ElMensaje, TipoMens, ElTitulo
            GoTo TheEnd
    Else
        cont = cont + 1
    End If
    Err.Clear
    On Error GoTo 0
    End If
Next
'Ordenamiento de hojas
For Act = 1 To Sheets.Count - 1
    For Sig = Act + 1 To Sheets.Count
        If UCase(Sheets(Act).Name) > UCase(Sheets(Sig).Name) And Sheets(Act).Name <> Excluir Then
            Sheets(Sig).Move Before:=Sheets(Act)
        End If
    Next Sig
Next Act
TheEnd:
    ElMensaje = IIf(cont = 0, "NO SE CAMBIO NINGUN NOMBRE DE HOJA", "Se renombraron: " & cont & " hoja" & IIf(cont > 1, "s", ""))
    TipoMens = IIf(cont = 0, vbCritical, vbInformation)
    ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
    Application.ScreenUpdating = True
    MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Espero que te satisfaga esta alternativa.

Saludos

Fernando

.

.

Buenas, de nuevo

Para acortar los nombres de la celda al máximo permitido de 31 caracteres, sólo tienes que agregar -en la macro- esta línea:

NomHoja = Left(NomHoja, IIf(Len(NomHoja) > 31, 31, Len(NomHoja)))

Reemplaza toda la rutina anterior por esta otra que ya la tiene agregada:

Sub NombraHojas()
'---- Variables modificables:
'=== FELIX: Modifica estos datos de acuerdo a tu planilla:  
NombreEn = "D2" ' celda donde está el nombre a dar a la hoja  
Quitar = "Nombre:"  
Excluir = "RESUMEN" ' si hubiera alguna hoja que no debería renombrarse  
'---- fin Variables
'
'---- inicio de rutina:
'  
Application.ScreenUpdating = False
For Each Hoja In Sheets
     If Hoja.Name <> Excluir Then
    NomHoja = Trim(Hoja.Range(NombreEn).Value)
    On Error Resume Next
    Hoja.Name = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar)))
    If Err <> 0 Then
            NomHoja = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar)))
            NomHoja = Left(NomHoja, IIf(Len(NomHoja) > 31, 31, Len(NomHoja)))
            ElMensaje = "La hoja actual no puede tomar el nombre" & Chr(10) & _
            IIf(Len(NomHoja), NomHoja, "<<está vacía!>>") & Chr(10) & "Modifiquelo en celda y relance esta macro" & Chr(10) & " Se interrumpe esta macro" & Chr(10)
            TipoMens = vbCritical
            ElTitulo = "NOMBRE INCOMPATIBLE!"
            Application.ScreenUpdating = True
            MsgBox ElMensaje, TipoMens, ElTitulo
            GoTo TheEnd
    Else
        cont = cont + 1
    End If
    Err.Clear
    On Error GoTo 0
    End If
Next
'Ordenamiento de hojas
For Act = 1 To Sheets.Count - 1
    For Sig = Act + 1 To Sheets.Count
        If UCase(Sheets(Act).Name) > UCase(Sheets(Sig).Name) And Sheets(Act).Name <> Excluir Then
            Sheets(Sig).Move Before:=Sheets(Act)
        End If
    Next Sig
Next Act
TheEnd:
    ElMensaje = IIf(cont = 0, "NO SE CAMBIO NINGUN NOMBRE DE HOJA", "Se renombraron: " & cont & " hoja" & IIf(cont > 1, "s", ""))
    TipoMens = IIf(cont = 0, vbCritical, vbInformation)
    ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
    Application.ScreenUpdating = True
    MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Espero que así quede mejor aún.

Abrazo
Fer

.

Sigue sin gustarle el nombre.

.

Es extraño, porque probé con ese caso, recortado y lo tomó.

Prueba con esta rutina simple:

sub aaprobar()
NomHoja = "CHRISTIAM Enrique Gonzalez Quiroz"
            NomHoja = Left(NomHoja, IIf(Len(NomHoja) > 31, 31, Len(NomHoja)))
ActiveSheet.Name = NomHoja
End Sub

El resultado será que la hoja quede como: CHRISTIAM Enrique Gonzalez Quir

Si no, es que hay otro problema.

Si Funciono con esa rutina.

Si tema va ser el largo porque también me pasa con otros nombres que son largos.

Alguna sugerencia ?

.

Hola!

La última rutina que te pasé era solo para probar que la solución de limitar los 31 caracteres funciona bien. No es para que la uses en todas las hojas.

Si te fijas, verás que es exactamente la misma instrucción que agregué dentro del procedimiento original. Por lo tanto debería funcionar para todas las hojas.

Por eso te comentaba que, tal vez, haya otro problema que interrumpa la rutina.

Si te volviera a suceder, envíame el nombre que debería usar y que detiene la ejecución de la rutina.

Saludos

Fernando

.

El otro Nombre Oscar Alejandro Van Horne Riva se detiene, cada vez que el nombre es largo me sale " no puede tomar el nombre ", y lo que hago es quitarle el ultimo apellido y funciona.

.

Buenas, Félix

La instrucción del límite de caracteres es correcta. El lugar donde la coloqué, no.

Por eso te envío esta variante que -hasta donde probé- funciona correctamente:

Sub NombraHojas()
'---- Variables modificables:
'=== FELIX: Modifica estos datos de acuerdo a tu planilla:  
NombreEn = "D2" ' celda donde está el nombre a dar a la hoja  
Quitar = "Nombre:"
Excluir = "RESUMEN" ' si hubiera alguna hoja que no debería renombrarse  
'---- fin Variables
'
'---- inicio de rutina:
'  
Application.ScreenUpdating = False
For Each Hoja In Sheets
     If Hoja.Name <> Excluir Then
    NomHoja = Trim(Hoja.Range(NombreEn).Value)
    'control de celda vacia:  
    NomHoja = IIf(Len(NomHoja), NomHoja, Quitar)
    'quita texto a la izquierda:  
    NomHoja = Trim(Right(NomHoja, Len(NomHoja) - Len(Quitar)))
    'Limita nombres extensos  
    NomHoja = Left(NomHoja, IIf(Len(NomHoja) > 31, 31, Len(NomHoja)))
    On Error Resume Next
    Hoja.Name = NomHoja
    If Err <> 0 Then
            ElMensaje = "La hoja actual no puede tomar el nombre" & Chr(10) & _
            IIf(Len(NomHoja), NomHoja, "<<está vacía!>>") & Chr(10) & "Modifiquelo en celda y relance esta macro" & Chr(10) & " Se interrumpe esta macro" & Chr(10)
            TipoMens = vbCritical
            ElTitulo = "NOMBRE INCOMPATIBLE!"
            Application.ScreenUpdating = True
            MsgBox ElMensaje, TipoMens, ElTitulo
            GoTo TheEnd
    Else
        cont = cont + 1
    End If
    Err.Clear
    On Error GoTo 0
    End If
Next
'Ordenamiento de hojas  
For Act = 1 To Sheets.Count - 1
    For Sig = Act + 1 To Sheets.Count
        If UCase(Sheets(Act).Name) > UCase(Sheets(Sig).Name) And Sheets(Act).Name <> Excluir Then
            Sheets(Sig).Move Before:=Sheets(Act)
        End If
    Next Sig
Next Act
TheEnd:
    ElMensaje = IIf(cont = 0, "NO SE CAMBIO NINGUN NOMBRE DE HOJA", "Se renombraron: " & cont & " hoja" & IIf(cont > 1, "s", ""))
    TipoMens = IIf(cont = 0, vbCritical, vbInformation)
    ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
    Application.ScreenUpdating = True
    MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Espero que ahora si te funcione como corresponde. Mis disculpas.

Abrazo

Fernando

.

¡Gracias! Excelente.

Que Curso me sugieres para poder hacer todo esto, conozco pero lo básico.