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.

1 Respuesta

Respuesta
2

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 Sub

Si 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 Sub

Y 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.

Añade tu respuesta

Haz clic para o
El autor de la pregunta ya no la sigue por lo que es posible que no reciba tu respuesta.

Más respuestas relacionadas