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