Añadir más condiciones con inputbox
Para Marcial
Hola que tal:
Tengo este código:
Sub Nueva_Antigua()
hoja_Nueva = (InputBox("Ponga el nombre de la NUEVA HOJA")) & hoja_Nueva
Hoja_Antigua = (InputBox("Ponga el nombre de la HOJA ANTIGUA ")) & Hoja_Antigua
Worksheets.Add(after:=Worksheets(Hoja_Antigua)).Name = hoja_Nueva
Application.ScreenUpdating = False
Application.Sheets("Enero").Visible = True
Sheets("Enero").Select
Cells.Copy
Sheets(hoja_Nueva).Paste
Application.Sheets("Enero").Visible = False
Sheets(hoja_Nueva).Select
Application.ScreenUpdating = True
[a1].Select
End Sub
Me funciona de maravilla.
Me surge una pregunta con todo este tema que antes del "(InputBox("Ponga el nombre de la NUEVA HOJA"))",
mediante otro inputbox o un msgbox preguntara si quiero poner el nombre en mayúscula o en minúscula,
y después de haber puesto si o no claro que pusiese las letra en mayúsculas o minúsculas dependiendo de lo elegido.
Después de haber puesto el nombre de la NUEVA HOJA por ejemplo en mayúsculas,,, mediante otro msgbox te haga una
confirmación de cuidado están activadas las mayúsculas, por lo tanto tendría que haber una variable o una instrucción
que averiguara si las mayúsculas están activadas, o no, y seguidamente después de la pregunta decirle si quiero dejarlas
en mayúsculas o por otro lado volver a escribir en minúsculas.
Creo haberme explicada, es un poquito rizar el rizo pero me gusta la idea si puede ser.
Aquí te dejo el código
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const VK_CAPITAL = &H14
Sub Nueva_Antigua()
Dim tipo As Variant
If GetKeyState(VK_CAPITAL) = 1 Then
resp = MsgBox("¡Las mayúsculas están activadas!" & Chr(13) & "¿Las desactivo? ", vbYesNo, "Desactivar mayúsculas")
If resp = vbYes Then SendKeys "{CAPSLOCK}" ' Pasa a minúsculas'
End If
'Mayúsculas o minúculas'
tipo = MsgBox("¿Nombre de hoja en Mayúsculas?", vbYesNo, "¿Mayúsculas o Minúsculas")
If tipo = vbYes Then tipo = 1 'Si responde sí ponemos tipo a 1 (Mayúsculas) para utilizarlo después'
Hoja_Nueva = (InputBox("Ponga el nombre de la NUEVA HOJA")) & Hoja_Nueva
'Si el tipo=1 entonces pasamos el nombre a mayúsculas, en caso contrario, en minúsculas'
If tipo = 1 Then Hoja_Nueva = UCase(Hoja_Nueva) Else Hoja_Nueva = LCase(Hoja_Nueva)
Hoja_Antigua = (InputBox("Ponga el nombre de la HOJA ANTIGUA ")) & Hoja_Antigua
Worksheets.Add(after:=Worksheets(Hoja_Antigua)).Name = Hoja_Nueva
Application.ScreenUpdating = False 'Para que no se vea la hoja oculta'
Application.Sheets("Enero").Visible = True
Sheets("Enero").Select
Cells.Copy
Sheets(Hoja_Nueva).Paste
Application.Sheets("Enero").Visible = False
Sheets(Hoja_Nueva).Select
Application.ScreenUpdating = True
[a1].Select
End SubSi te ha valido la respuesta.
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Toda esta línea se pone en rojo y sale un cartelito que dice:
Error de compilación,,El código de este proyecto se debe actualizar para usarse en sistemas de 64bits.Revise y actualice las instrucciones Declare y, a continuación,márquelas con el atributo PtrSafe.
Pon estas dos líneas en un módulo. Saludos
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As IntegerPrivate Const VK_CAPITAL = &H14
Así:
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Const VK_CAPITAL = &H14
A ver, he hecho algunas modificaciones en el módulo para que compruebe si existe la hoja Antigua, si no existe, vuelve a pedir el nombre. También le he puesto que si pulsamos Cancelar finalice la macro.
Pon esto en Thisworkbook o en un módulo
Sub Nueva_Antigua()
Dim tipo As Variant, Hoja_Antigua As String
If GetKeyState(VK_CAPITAL) = 1 Then
resp = MsgBox("¡Las mayúsculas están activadas!" & Chr(13) & "¿Las desactivo? ", vbYesNo, "Desactivar mayúsculas")
If resp = vbYes Then SendKeys "{CAPSLOCK}" ' Pasa a minúsculas'
End If
'Mayúsculas o minúsculas'
tipo = MsgBox("¿Nombre de hoja en Mayúsculas?", vbYesNo, "¿Mayúsculas o Minúsculas")
If tipo = vbYes Then tipo = 1 'Si responde sí ponemos tipo a 1 (Mayúsculas) para utilizarlo después'
Hoja_Nueva = (InputBox("Ponga el nombre de la NUEVA HOJA")) & Hoja_Nueva
If Hoja_Nueva = "" Then Exit Sub 'Pulsamos Cancelar'
'Si el tipo=1 entonces pasamos el nombre a mayúsculas, en caso contrario, en minúsculas'
If tipo = 1 Then Hoja_Nueva = UCase(Hoja_Nueva) Else Hoja_Nueva = LCase(Hoja_Nueva)
Do
Hoja_Antigua = (InputBox("Ponga el nombre de la HOJA ANTIGUA "))
If Hoja_Antigua = "" Then Exit Sub 'Pulsamos Cancelar'
If Not ExisteHoja(Hoja_Antigua) Then MsgBox ("La hoja no existe, escriba de nuevo el nombre")
Loop While Not ExisteHoja(Hoja_Antigua)
Worksheets.Add(after:=Worksheets(Hoja_Antigua)).Name = Hoja_Nueva
Application.ScreenUpdating = False 'Para que no se vea la hoja oculta'
Application.Sheets("Enero").Visible = True
Sheets("Enero").Select
Cells.Copy
Sheets(Hoja_Nueva).Paste
Application.Sheets("Enero").Visible = False
Sheets(Hoja_Nueva).Select
Application.ScreenUpdating = True
[a1].Select
End SubY esto en un módulo
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Public Const VK_CAPITAL = &H14 Function ExisteHoja(Hoja As String) As Boolean For i = 1 To Worksheets.Count If Worksheets(i).Name = Hoja Then ExisteHoja = True Exit Function End If Next ExisteHoja = False End Function
Si te ha valido la respuesta.
