Looking for veryhidden sheet help

braindiesel

Well-known Member
Joined
Mar 16, 2009
Messages
571
Office Version
  1. 365
  2. 2019
  3. 2010
Platform
  1. Windows
I have a sheet that I want to make very hidden.
If someone were to reveal that sheet, I would like code to run to shut the file down

My thinking is to put code on the sheet tab that if that specific sheet is visible my desired code runs.
Sort of a boobytrap against someone running "show all sheets"

I should be okay with the desired code... but I am struggling with how to determine that this active sheet is visible, or preferably, if it's status changes from veryhidden to hidden or visible.

Any help is appreciated
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Hi,

you could do something like this

Code:
Private Sub Worksheet_Activate()
    Me.Visible = xlSheetVeryHidden
End Sub

This code is placed in your worksheets code page & If the sheet is made visible, then as soon as it is selected it will be hidden.

For the casual user this may be enough - HOWEVER Excel is not a secure environment to store sensitive data & should understand that such approaches are very easy to defeat. In above example, Users can set EnableEvents property to False which turns all event codes off or just not enable macros.

On a personal note, not a good idea to "booby trap" any workbook or do anything that alters a users desktop settings - as clever as it may seem in vain attempt to protect workbook and it's contents, your users will not thank you & likely not to use the workbook.

Others here may have alternative suggestions


Hope Helpful

Dave
 
Upvote 0
If "show all sheets" is a macro, then change it to only unhide hidden rather than very hidden sheets & lock the VBA project with a password.
 
Upvote 0
I haven't done a lot with very hidden. I have been tasked with trying to prevent someone from copying or duplicating the document...
I have some ideas that will prevent the casual users.
My reference to "Show all sheets" is that someone wishing to see sheets that they cannot see would have to use VBA code, so if they happened to try to unhide all sheets, which they could do with VBA, it would reveal this boobytrapped sheet, whose whole purpose is to force close the document.

As for those who would open it without activating macros, I have some ideas on how to work around that so that they MUST enable macros.

The code above is good if they click on it... thank you for that.
Is there a way to run code if it is visible regardless of where they click?
 
Upvote 0
but I am struggling with how to determine that this active sheet is visible, or preferably, if it's status changes from veryhidden to hidden or visible.

Try this API approach and see if it works for you :

Place the following code in a Standard Module:
Code:
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Dim pVTable As LongPtr
    Dim initAddr As LongPtr

    Declare PtrSafe Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Long
    Declare PtrSafe Function GlobalGetAtomName Lib "kernel32" Alias "GlobalGetAtomNameA" (ByVal nAtom As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function VirtualProtect Lib "kernel32.dll" (ByVal lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Dim pVTable As Long
    Dim initAddr As Long
    
    Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As long
    Declare Function GlobalGetAtomName Lib "kernel32" Alias "GlobalGetAtomNameA" (ByVal nAtom As long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
    Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function VirtualProtect Lib "kernel32.dll" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Const PAGE_EXECUTE_READWRITE As Long = &H40&
Const lFuncOffset As Long = 320 [B][COLOR=#008000]' Sheet Visible VTable Offset[/COLOR][/B]


Sub Hook_Sheet_Visibile_Property(ByVal Sh As Worksheet)
    If GetProp(Application.hwnd, "HookSet") = 0 Then
        Call SetProp(Application.hwnd, "SheetName", GlobalAddAtom(Sh.Name))
        CopyMemory pVTable, ByVal ObjPtr(Sh), LenB(pVTable)
        CopyMemory initAddr, ByVal pVTable + lFuncOffset, LenB(initAddr)
        VirtualProtect pVTable + lFuncOffset, 4, PAGE_EXECUTE_READWRITE, 0
        CopyMemory ByVal pVTable + lFuncOffset, AddressOf OverrideFunction, LenB(pVTable)
        Call SetProp(Application.hwnd, "pVtable", pVTable)
        Call SetProp(Application.hwnd, "initAddr", initAddr)
        Call SetProp(Application.hwnd, "HookSet", 1)
    End If
End Sub

Sub UnHook_Sheet_Visibile_Property()
    If GetProp(Application.hwnd, "HookSet") = 1 Then
        pVTable = GetProp(Application.hwnd, "pVTable")
        initAddr = GetProp(Application.hwnd, "initAddr")
        CopyMemory ByVal pVTable + lFuncOffset, initAddr, LenB(pVTable)
        Call RemoveProp(Application.hwnd, "HookSet")
    End If
End Sub

Sub Auto_Close()
    [B][COLOR=#008000]'safety routine.[/COLOR][/B]
    Call UnHookComFunction
End Sub


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Function OverrideFunction(ByVal voObjPtr As LongPtr, ByVal Icid As Long, ByVal XLSheetVisibility As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Function OverrideFunction(ByVal voObjPtr As Long, ByVal Icid As Long, ByVal XLSheetVisibility As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim oTempWs As Worksheet
    Dim sBuffer As String
    Dim lRet As Long
    
    sBuffer = Space(256)
    lRet = GlobalGetAtomName(CLng(GetProp(Application.hwnd, "SheetName")), sBuffer, Len(sBuffer))
    sBuffer = Left(sBuffer, lRet)
    
    Call UnHook_Sheet_Visibile_Property
    CopyMemory oTempWs, voObjPtr, LenB(voObjPtr)
    If XLSheetVisibility = xlSheetVisible Then
        If oTempWs.Name = sBuffer Then
            MsgBox "Oops!" & vbLf & "You can't unhide the worksheet : '" & sBuffer & "'", vbCritical
        Else
            oTempWs.Visible = xlSheetVisible
        End If
    End If
    Call Hook_Sheet_Visibile_Property(oTempWs)
    CopyMemory oTempWs, 0, LenB(voObjPtr)
    Set oTempWs = Nothing
End Function

Test demo:

and here is a test that shows how to prevent the xlSheetVeryHidden Sheet1 from becoming visible :

Code:
Sub Test()
    Call Hook_Sheet_Visibile_Property(Sheet1)
    Sheet1.Visible = xlSheetVisible
End Sub

Sub ResetDefault()
    Call UnHook_Sheet_Visibile_Property
    Sheet1.Visible = xlSheetVisible
End Sub

I've written and tested this on excel 64bit only but hopefully it should also work for 32bit.
 
Upvote 0
Edit time Up.

Sorry there is a logical error in the above code so please ignore it and use this one :

Code:
Option Explicit

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Dim pVTable As LongPtr
    Dim initAddr As LongPtr

    Declare PtrSafe Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Long
    Declare PtrSafe Function GlobalGetAtomName Lib "kernel32" Alias "GlobalGetAtomNameA" (ByVal nAtom As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function VirtualProtect Lib "kernel32.dll" (ByVal lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Dim pVTable As Long
    Dim initAddr As Long
    
    Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As long
    Declare Function GlobalGetAtomName Lib "kernel32" Alias "GlobalGetAtomNameA" (ByVal nAtom As long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
    Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function VirtualProtect Lib "kernel32.dll" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Const PAGE_EXECUTE_READWRITE As Long = &H40&
Const lFuncOffset As Long = 320 [B][COLOR=#008000]' Sheet Visible VTable Offset[/COLOR][/B]


Sub Hook_Sheet_Visibile_Property(ByVal Sh As Worksheet)
    If GetProp(Application.hwnd, "HookSet") = 0 Then
        Call SetProp(Application.hwnd, "SheetName", GlobalAddAtom(Sh.Name))
        CopyMemory pVTable, ByVal ObjPtr(Sh), LenB(pVTable)
        CopyMemory initAddr, ByVal pVTable + lFuncOffset, LenB(initAddr)
        VirtualProtect pVTable + lFuncOffset, 4, PAGE_EXECUTE_READWRITE, 0
        CopyMemory ByVal pVTable + lFuncOffset, AddressOf OverrideFunction, LenB(pVTable)
        Call SetProp(Application.hwnd, "pVtable", pVTable)
        Call SetProp(Application.hwnd, "initAddr", initAddr)
        Call SetProp(Application.hwnd, "HookSet", 1)
    End If
End Sub

Sub UnHook_Sheet_Visibile_Property()
    If GetProp(Application.hwnd, "HookSet") = 1 Then
        pVTable = GetProp(Application.hwnd, "pVTable")
        initAddr = GetProp(Application.hwnd, "initAddr")
        CopyMemory ByVal pVTable + lFuncOffset, initAddr, LenB(pVTable)
        Call RemoveProp(Application.hwnd, "HookSet")
    End If
End Sub

Sub Auto_Close()
[B][COLOR=#008000]    'safety routine.[/COLOR][/B]
    Call UnHookComFunction
End Sub


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Function OverrideFunction(ByVal voObjPtr As LongPtr, ByVal Icid As Long, ByVal XLSheetVisibility As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Function OverrideFunction(ByVal voObjPtr As Long, ByVal Icid As Long, ByVal XLSheetVisibility As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim oTempWs As Worksheet
    Dim sBuffer As String
    Dim lRet As Long
    
    sBuffer = Space(256)
    lRet = GlobalGetAtomName(CLng(GetProp(Application.hwnd, "SheetName")), sBuffer, Len(sBuffer))
    sBuffer = Left(sBuffer, lRet)
    
    Call UnHook_Sheet_Visibile_Property
    CopyMemory oTempWs, voObjPtr, LenB(voObjPtr)
    If XLSheetVisibility = xlSheetVisible Then
        If oTempWs.Name = sBuffer Then
            MsgBox "Oops!" & vbLf & "You can't unhide the worksheet : '" & sBuffer & "'", vbCritical
        Else
            oTempWs.Visible = xlSheetVisible
        End If
    End If
    Call Hook_Sheet_Visibile_Property(Worksheets(sBuffer))
    CopyMemory oTempWs, 0, LenB(voObjPtr)
    Set oTempWs = Nothing
End Function

Test code :

Code:
Sub Test()
    Call Hook_Sheet_Visibile_Property(Sheet1)
    Sheet1.Visible = xlSheetVisible
End Sub

Sub ResetDefault()
    Call UnHook_Sheet_Visibile_Property
    Sheet1.Visible = xlSheetVisible
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,908
Messages
6,175,307
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top