Hacer que una macro solo abra una sola hoja del libro al abrirse y que si pasa la prueba de apertura cierre esa y abra 3 más
Dante amor
Siguiendo con nuestro ejemplo, que tal si por ejemplo entonces hacemos lo siguiente en base a la macro del que estábamos hablando:
Sub Macro1()
'Act.Por.Dante Amor
Dim FileWsh As Object
Set FileWsh = CreateObject("Scripting.FileSystemObject")
MiVolumen = Hex$(FileWsh.Drives("C").SerialNumber)
Select Case MiVolumen
Case "FC3C0246", "3297E471", "3090801F", "0ED20881", "E447E187"
MsgBox " Computador Autorizado" & vbCr & vbCr & _
"Gracias por utilizar Software Legal", , ""
Case Else
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End Select
Set FileWsh = Nothing
End SubQue tal si entonces le adicionamos lo siguiente:
1. Cuando abra el archivo, abre solo con 1 sola hoja visible llamada "BIENVENIDA", las demás las mantiene ocultas. Así obligo a la persona a habilitar las macros como tu decías en la anterior pregunta, al habilitar las macros ahí si se ejecuta la macro1 que te envié ahorita y si pasa la verficación entonces oculta la hoja "Bienvenida" y vuelve visibles las hojas "Cumpleaños" "Amigas" "Regalos"
Si no pasa la verficacion elimina el archivo
¿Te parece?
1 Respuesta
H o l a:
Realiza los siguientes pasos en tu archivo.
1. Entra a VBA, con cada hoja, excepto la hoja de "Bienvenida", en propiedades selecciona Visible = 2 - xlsheetveryhidden
2. En los eventos de thisworkbook pon los siguientes:
Private Sub Workbook_Open()
'Por.Dante Amor
Application.ScreenUpdating = False
Dim FileWsh As Object
Set FileWsh = CreateObject("Scripting.FileSystemObject")
MiVolumen = Hex$(FileWsh.Drives("C").SerialNumber)
Select Case MiVolumen
Case "FC3C0246", "3297E471", "3090801F", "0ED20881", "E447E187"
MsgBox " Computador Autorizado" & vbCr & vbCr & _
"Gracias por utilizar Software Legal", , ""
For Each h In Sheets
h.Visible = True
Next
Sheets("Bienvenida").Visible = xlVeryHidden
Case Else
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End Select
Set FileWsh = Nothing
End Sub
'
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
Application.ScreenUpdating = False
Sheets("Bienvenida").Visible = True
For Each h In Sheets
If h.Name <> "Bienvenida" Then
h.Visible = xlVeryHidden
End If
Next
ThisWorkbook.Save
End Sub