Ordenar y renombrar hojas de excel de acuerdo al nombre de cada hoja.
Tengo un formulario que al presionar un botón me crea una hoja y después me sale automáticamente un inputbox o una caja de texto donde introduzco el nombre de la hoja y después esta se crea. Quisiera que me ayudaran con un código para que por ejemplo:
En mi libro las hojas existentes tienen por nombre:
La hoja numero 1 tiene por nombre 1.1 la hoja numero 2 tiene por nombre 1.2 y en general el orden esta así:
1.1 - 1.2 - 1.3 - 2.1 - 2.2
Quiero que si en la caja de texto introduzco el nombre de la hoja a crear por nombre 2.1 el orden y los nombres quedaran así ahora:
1.1 - 1.2 - 1.3 - 2.1 - 3.1 - 3.2
Si pueden ver la hoja 2.1 se creo y ubico entre las hojas del grupo 1 y grupo 2 y las hojas que se llamaban 2.1 y 2.2 ahora se llaman 3.1 y 3.2. Además todas las hojas se ordenaron de acuerdo al primer numero. Pero si coloco por nombre a la hoja a crear 1.2 el orden quede así:
1.1 - 1.2 - 1.3 -1.4 - 2.1 - 2.2
La hoja que se llamaba 1.2 ahora sr llama 1.3 y la que se llamaba 1.3 ahora se llama 1.4
Les agradezco su atención y colaboración, he buscado en otros sitios pero no con algo similar.
1 Respuesta
Te anexo la macro
Private Sub CommandButton1_Click()
' Crear Hoja
' Por Dante Amor
'
'Validaciones
nombre = TextBox1.Value
If nombre = "" Or Not IsNumeric(nombre) Then
MsgBox "Escribe el nombre de hoja"
TextBox1.SetFocus
Exit Sub
End If
'
existe = False
For i = 1 To Sheets.Count
If Sheets(i).Name = nombre Then
existe = True
Exit For
End If
Next
If existe Then
res = MsgBox("La hoja ya existe. Quieres Renombrar Las Hojas", vbQuestion & vbYesNo)
If res = vbNo Then Exit Sub
End If
'
If existe Then
'Renombrar hojas
nombre = Val(nombre)
entero = Int(nombre)
ini = 0
fin = 0
For i = 1 To Sheets.Count
ent_actual = Int(Val(Sheets(i).Name))
If ent_actual = entero Then
If ini = 0 Then
ini = i
fin = i
Else
fin = i
End If
End If
Next
creada = False
For i = fin To ini Step -1
hoja = Sheets(i).Name
If IsNumeric(hoja) Then
hoja = Val(hoja)
If hoja < Val(nombre) Then
creada = True
Sheets.Add after:=Sheets(i)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó y se renombraron las demás"
Exit Sub
Else
Sheets(i).Name = hoja + 0.1
End If
End If
Next
If creada = False Then
Sheets.Add before:=Sheets(ini)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó y se renombraron las demás"
Exit Sub
End If
Else
'Crear hoja
For i = Sheets.Count To 1 Step -1
hoja = Sheets(i).Name
If IsNumeric(hoja) Then
hoja = Val(hoja)
If hoja < Val(nombre) Then
Sheets.Add after:=Sheets(i)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó"
Exit Sub
End If
End If
Next
End If
End Sub[Sal u dos. No olvides valorar la respuesta.
Cuando en el textbox escribo el nombre de la hoja por ejemplo 1.2 a crear me dice que la hoja ya existe y le doy aceptar me quedan nombradas las hojas con una coma :
1,1 - 1,2 - 1,3 - 2.1 - 2.2
Pero el problema es que si vuelvo a crear una hoja con el mismo nombre por ejemplo 1,2 me arroja un error en esta línea:
Sheets(i).Name = hoja + 0.1 y que el nombre ya esta ocupado
Cambie la configuración de región e idioma y puse:
Símbolo decimal: . (un punto)
Símbolo de separación de miles:, ( una coma)
Y me funciono la macro. Como la podría adaptar a mi región. Y también a veces pasa que si por ejemplo elimino la hoja llamada 1.1 y quiero nombrar una nueva con el mismo nombre ejecuto la macro pero no sucede nada. Aquí le dejo el link del archivo . Disculpe la molestia.
¿Sabes hacer debug a la macro?
Ve ejecutando línea por línea la macro y después de esta línea:
Nombre = Val(nombre)
Acerca el apuntador del mouse a la variable nombre, dime qué valor tiene: 1.¿2 ó 1,2?
Tengo que hacer varios ajustes a la macro para que funcione con comas como separador decimal.
Por otra parte si resuelves lo de la región, te anexo la macro con el ajuste para agregar la hoja 1.1 (primera hoja)
Private Sub CommandButton1_Click()
' Crear Hoja
' Por Dante Amor
'
'Validaciones
nombre = TextBox1.Value
If nombre = "" Or Not IsNumeric(nombre) Then
MsgBox "Escribe el nombre de hoja"
TextBox1.SetFocus
Exit Sub
End If
'
existe = False
For i = 1 To Sheets.Count
If Sheets(i).Name = nombre Then
existe = True
Exit For
End If
Next
If existe Then
res = MsgBox("La hoja ya existe. Quieres Renombrar Las Hojas", vbQuestion & vbYesNo)
If res = vbNo Then Exit Sub
End If
'
If existe Then
'Renombrar hojas
nombre = Val(nombre)
entero = Int(nombre)
ini = 0
fin = 0
For i = 1 To Sheets.Count
ent_actual = Int(Val(Sheets(i).Name))
If ent_actual = entero Then
If ini = 0 Then
ini = i
fin = i
Else
fin = i
End If
End If
Next
creada = False
For i = fin To ini Step -1
hoja = Sheets(i).Name
If IsNumeric(hoja) Then
hoja = Val(hoja)
If hoja < Val(nombre) Then
creada = True
Sheets.Add after:=Sheets(i)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó y se renombraron las demás"
Exit Sub
Else
Sheets(i).Name = hoja + 0.1
End If
End If
Next
If creada = False Then
Sheets.Add before:=Sheets(ini)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó y se renombraron las demás"
Exit Sub
End If
Else
'Crear hoja
For i = Sheets.Count To 1 Step -1
hoja = Sheets(i).Name
If IsNumeric(hoja) Then
hoja = Val(hoja)
If hoja < Val(nombre) Then
Sheets.Add after:=Sheets(i)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó"
Exit Sub
End If
End If
Next
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó"
End If
End Sub[No olvides valorar la respuesta.
Le hice el debug como me dijiste pero me di cuenta que esa variable es igual al nombre que ingreso en el textbox (ingrese por ejemplo 1.3 y la variable es 1.3 ; No es 2 ó 1,2 como me dijiste) . Porque sino ingreso la variable no sigue haciendo la depuración. No se si eso fue lo que querías que hiciera.
Cambié mi configuración regional para realizar las pruebas. Te anexo la macro actualizada:
Private Sub CommandButton1_Click()
' Crear Hoja
' Por Dante Amor
'
'Validaciones
nombre = TextBox1.Value
If nombre = "" Or Not IsNumeric(nombre) Then
MsgBox "Escribe el nombre de hoja"
TextBox1.SetFocus
Exit Sub
End If
'
existe = False
For i = 1 To Sheets.Count
If Sheets(i).Name = nombre Then
existe = True
Exit For
End If
Next
If existe Then
res = MsgBox("La hoja ya existe. Quieres Renombrar Las Hojas", vbQuestion & vbYesNo)
If res = vbNo Then Exit Sub
End If
'
If existe Then
'Renombrar hojas
'nombre = Val(nombre)
entero = Int(Val(nombre))
ini = 0
fin = 0
For i = 1 To Sheets.Count
ent_actual = Int(Val(Sheets(i).Name))
If ent_actual = entero Then
If ini = 0 Then
ini = i
fin = i
Else
fin = i
End If
End If
Next
creada = False
For i = fin To ini Step -1
hoja = Sheets(i).Name
If IsNumeric(hoja) Then
hoja = Val(hoja)
If hoja < Val(nombre) Then
creada = True
Sheets.Add after:=Sheets(i)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó y se renombraron las demás"
Exit Sub
Else
wsuma = hoja + 0.1
Sheets(i).Name = Replace(wsuma, ",", ".")
End If
End If
Next
If creada = False Then
Sheets.Add before:=Sheets(ini)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó y se renombraron las demás"
Exit Sub
End If
Else
'Crear hoja
For i = Sheets.Count To 1 Step -1
hoja = Sheets(i).Name
If IsNumeric(hoja) Then
hoja = Val(hoja)
'wnom = Val(nombre)
If hoja < Val(nombre) Then
Sheets.Add after:=Sheets(i)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó"
Exit Sub
End If
End If
Next
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = nombre
MsgBox "La hoja se agregó"
End If
End Sub[' No olvides valorar la respuesta.
