Heeeeeellllp! Excel is stuck!!?? This is puzzling

[dcompagnone]

Hi Professionals!

I was puzzling this out for ages and then found a little gem that got me on the right path and I've hit a problem which I can't resolve.

The following code is called through LightBox.Show by various named buttons.

The first part of this works with absolutely no problem at all. The forst transparent userform loads and then the target userform loads over the top.

Once the second userform loads, the user has the option to input data which should be transferred back to the relevant sheet on 'OK'.

The problem is that once the two uderforms are on the screen, i can't get them off. Literally. Escape, close, ok...nothing removes them. This leads me to think that I need to add something else to the code but, for the life of me, I haven't worked out what it is.

Can you top-class, grade A, professional, excel masters, PLEASE tell me what's missing.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function BringWindowToTop Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long

Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000


Const WS_SYSMENU = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Dim hWnd As Long

Private Sub UserForm_Initialize()
Dim lngWindow As Long, lFrmHdl As Long
lFrmHdl = FindWindow(vbNullString, Me.Caption)
lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
lngWindow = lngWindow And (Not WS_CAPTION)
Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
Call DrawMenuBar(lFrmHdl)
End Sub

Private Sub UserForm_activate()
Dim ufcap As String
ufcap = LightBox.Caption
hWnd = FindWindow("ThunderDFrame", ufcap)

' Adjust UserForm to Excel's window size
With LightBox
.Height = Application.Height
.Width = Application.Width
.Left = Application.Left
.Top = Application.Top
End With
TransparentUserForm Me, 180 'increase to make darker

Select Case Application.Caller
Case "Lock Unlock"
Call password_submit

Case "Sample Add"
Call ShowSampleForm

Case "Account Info"
Call Account_Infor

Case "Project Contact"
Call ProjectContacts_Update

Case "Status Update"
Call Show_Status_Update

Case "Add Background"
Call background

Case "Add Activity"
Call NewActivityItem

End Select
End Sub

Private Function TransparentUserForm(frm As UserForm, Level As Byte) As Boolean
' Makes a UserForm transparent, semi-transparent, or invisible
' Level: 0 to 255
SetWindowLong hWnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, 0, Level, LWA_ALPHA
TranslucentForm = Err.LastDllError = 0
End Function



Thanks

Dominic

 

[Jaafar Tribak]

Hi Dominic.

You should be able to close the captionless userforms by pressing ALT+F4 keys.

However, if you think that pressing the Escape Key is more intuitive then here is a Workbook example that shows how to that.

Code in the UserForm Module :

Option Explicit
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type Msg
    hWnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
 
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
 
Private Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
 
Private Declare Function RegisterHotKey Lib "user32" _
(ByVal hWnd As Long, ByVal id As Long, _
ByVal fsModifiers As Long, ByVal vk As Long) As Long
 
Private Declare Function UnregisterHotKey Lib "user32" _
(ByVal hWnd As Long, ByVal id As Long) As Long
 
Private Declare Function PeekMessage Lib "user32" _
Alias "PeekMessageA" _
(lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
 
Private Declare Function WaitMessage Lib "user32" () As Long
 
Private Const GWL_STYLE = -16
Private Const GWL_EXSTYLE = (-20)
Private Const WS_CAPTION = &HC00000
Private Const WS_SYSMENU = &H80000
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
 
Private bCancel As Boolean
Private lFrmHdl As Long

Private Sub UserForm_Initialize()
 
    Call RemoveFormCaption
    'make the form semi-transparent
    Call TransparentUserForm(Me, 180)  'increase to make darker

End Sub
 
Private Sub UserForm_Activate()
 
    'hook the ESC key to close the Form.
    RegisterTheHotKey vbKeyEscape
 
End Sub
 
'=======================
'// Supporting routines.
'=======================
Private Sub RemoveFormCaption()
 
    Dim lStyle As Long
    
    'remove the form caption.
    lFrmHdl = FindWindow(vbNullString, Me.Caption)
    lStyle = GetWindowLong(lFrmHdl, GWL_STYLE)
    lStyle = lStyle And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lStyle)
    Call DrawMenuBar(lFrmHdl)
 
End Sub
 
Private Function TransparentUserForm _
(frm As UserForm, Level As Byte) As Boolean
 
    ' Makes a UserForm transparent, semi-transparent, or invisible
    ' Level: 0 to 255
    SetWindowLong lFrmHdl, GWL_EXSTYLE, WS_EX_LAYERED
    SetLayeredWindowAttributes lFrmHdl, 0, Level, LWA_ALPHA
    
End Function

Private Sub RegisterTheHotKey(Key)
 
    Dim ret As Long
    
    bCancel = False
    'register the ESCAPE hotkey
    ret = RegisterHotKey(lFrmHdl, &HBFFF&, 0, Key)
    
    'process the Hotkey messages
    ProcessMessages
 
End Sub
 
Private Sub ProcessMessages()
 
    Dim Message As Msg
    
    On Error Resume Next
    
    'loop until bCancel is set to True
    Do
    
        'wait for a message
        WaitMessage
        'check if it's a HOTKEY-message
        If PeekMessage _
        (Message, lFrmHdl, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
            
             bCancel = True
    
            'unregister hotkey
            Call UnregisterHotKey(lFrmHdl, &HBFFF&)
 
        End If
        
        'let the operating system process other events
        DoEvents
        
    Loop Until bCancel
 
    'Unload the Form.
     Unload Me
 
End Sub