dcompagnone
Board Regular
- Joined
- Dec 14, 2007
- Messages
- 119
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
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
Last edited: