Hola a todos,

Tengo este evento creado de tipo Worksheet_BeforeDelete:

Private Sub Worksheet_BeforeDelete()

Application.ScreenUpdating = False
Application.StatusBar = "Procedimiento en ejecución..."

   ' Limpiamos los errores anteriores (por si acaso)...
   Err.Clear

   ' Tratamos los errores del evento...
   On Error Resume Next

   ' Si la contraseña no coincide, entonces...
   If FUNCIONES.comprobarContraseña(CONTRASEÑA_HOJA) = False Then
      ' Copiamos la hoja...
      ThisWorkbook.ActiveSheet.Copy After:=Sheets(ThisWorkbook.ActiveSheet.Index)
      ' Y notificamos al usuario con un mensaje de alerta...
      MsgBox Prompt:="Upps, parece que hubo un error... Por favor, introduzca la contraseña correcta.", _
             Buttons:=vbCritical, _
             Title:="CONTRASEÑA INCORRECTA"
   ' En caso contrario...
   Else
      ' Notificamos al usuario con un mensaje de información...
      MsgBox Prompt:="La hoja de datos " & HOJA & " del libro " & ThisWorkbook.Name & " se ha eliminado correctamente.", _
             Buttons:=vbInformation, _
             Title:="HOJA DE DATOS ELIMINADA CON EXITO"
   End If

Application.StatusBar = False

End Sub

La función comprobarContraseña también es muy sencillita:

Function comprobarContraseña(CONTRASEÑA_HOJA As String) As Boolean

   ' Tratamos los errores de la función...
   On Error Resume Next

   ' Declaramos las variables de ámbito local...
   Dim contraseña As String
   contraseña = InputBox(Prompt:="Por favor, introduzca la contraseña de la hoja:", _
                         Title:="INSERTAR CONTRASEÑA")

   ' Si la contraseña no coincide, entonces...
   If contraseña <> CONTRASEÑA_HOJA Then
      comprobarContraseña = False
   ' En caso contrario...
   Else
      comprobarContraseña = True
   End If

End Function

Las variables HOJA y CONTRASEÑA_HOJA las tengo declaradas como constantes públicas, aunque en este caso se pueden sustituir por cualquier valor.

Bueno, con el código anterior en mano, mi idea es la siguiente: "Quiero que el usuario antes de eliminar la hoja introduzca una contraseña en un InputBox. Si coincide, entonces se muestra un mensaje de confirmación al usuario y la hoja se elimina. Y si la contraseña de la hoja no coincide, entonces se crea una copia de la hoja y se muestra un mensaje de error al usuario". Es simple.

Pero el problema que tengo es que siempre que la contraseña no coincide, se crea una copia de la hoja con el nombre seguido de un número.

Por ejemplo: Eliminamos la "Hoja1" y acto seguido se crea la hoja "Hoja1 (1)", eliminamos la "Hoja1 (1)" y acto seguido se crea la hoja "Hoja1 (2)", eliminamos la "Hoja1 (2)" y acto seguido se crea la hoja "Hoja1 (3)", y así sucesivamente...

Simplemente, quiero que la copia creada se llame "Hoja1", pero me devuelve un error de tipo "La hoja creada ya existe".

 

En fin, espero haberme explicado bien.

Agradezco cualquier aporte por vuestra parte.

 

Saludos, y muchas gracias por vuestro tiempo.

Se puede, pero con un userform intermedio. 

¡Cuidado! el formulario debe tener la propiedad ShowModal=False.

Abre el adjunto e intenta eliminar la hoja Hoja1,  pon una contraseña errónea.

Cancelar delete sheet.xlsm

Hola @Antoni,

 

Muchas gracias por tomarte un tiempo en responderme.

Voy a estudiar tu código, y coger ideas que siempre es bueno para cultivar mi conocimiento.

 

El caso es que ya lo solucioné de una manera mucho más sencilla, y es del siguiente modo:

 

Paso 1) Este es el código de la función comprobarContraseña:

Function comprobarContraseña(CONTRASEÑA_HOJA As String) As Boolean

   ' Tratamos los errores de la función...
   On Error Resume Next

   ' Declaramos las variables de ámbito local...
   Dim contraseña As String
   contraseña = InputBox(Prompt:="Por favor, introduzca la contraseña de la hoja:", _
                         Title:="INSERTAR CONTRASEÑA")

   ' Si la contraseña no coincide, entonces...
   If contraseña <> CONTRASEÑA_HOJA Then
      comprobarContraseña = False
   ' En caso contrario...
   Else
      comprobarContraseña = True
   End If

End Function

Paso 2) Este es el código del evento Worksheet_BeforeDelete:

Private Sub Worksheet_BeforeDelete()

Application.ScreenUpdating = False
Application.StatusBar = "Procedimiento en ejecución..."

   ' Limpiamos los errores anteriores (por si acaso)...
   Err.Clear

   ' Tratamos los errores del evento...
   On Error Resume Next

   ' Si la contraseña no coincide, entonces...
   If FUNCIONES.comprobarContraseña(CONTRASEÑA_HOJA) = False Then
      ' Copiamos la hoja...
      ThisWorkbook.ActiveSheet.Copy After:=Sheets(ThisWorkbook.ActiveSheet.Index)
      ' Y notificamos al usuario con un mensaje de error...
      MsgBox Prompt:="Upps, parece que hubo un error... Por favor, introduzca la contraseña correcta.", _
             Buttons:=vbCritical, _
             Title:="CONTRASEÑA INCORRECTA"
   ' En caso contrario...
   Else
      ' Notificamos al usuario con un mensaje de confirmación...
      MsgBox Prompt:="La hoja de datos " & HOJA & " del libro " & ThisWorkbook.Name & " se ha eliminado correctamente.", _
             Buttons:=vbInformation, _
             Title:="HOJA DE DATOS ELIMINADA CON EXITO"
   End If

Application.StatusBar = False

End Sub

Y paso 3: Este es el código del evento Worksheet_Activate:

Private Sub Worksheet_Activate()

Application.ScreenUpdating = False
Application.StatusBar = "Procedimiento en ejecución..."

   ' Limpiamos los errores anteriores (por si acaso)...
   Err.Clear

   ' Tratamos los errores del evento...
   On Error Resume Next

   ' Y renombramos la hoja (por si acaso)...
   If ThisWorkbook.ActiveSheet.Name <> HOJA Then ThisWorkbook.ActiveSheet.Name = HOJA

Application.StatusBar = False

End Sub

 

Poniéndo este código en orden, entonces ya se puede eliminar cualquier hoja del libro solicitándo una contraseña al usuario.

 

Decir también que las variables HOJA y CONTRASEÑA_HOJA, son constantes.

De manera que habría que declararlas en la zona de declaraciones del módulo. Por ejemplo:

Const HOJA As String = "MiHoja"
Const CONTRASEÑA_HOJA As String = "MiContraseña"

 

Aunque todo esto @Antoni, ya lo dominas a la perfección... Jejeje.

Pero lo dejo por el foro, por si alguien se anima a leerlo.

 

Saludos.

Editado el el 23 de julio3 años por paikerr