Hi,
I have copied this code from the internet and it fades in my UserForm1 when called.
Form Fader:
BackgroundTest userform
What I would like is to amend it so it fades in the following userforms as well:
NewProduct
Password
Search
Hope this all makes sense.
Kind Regards
Dan
I have copied this code from the internet and it fades in my UserForm1 when called.
Form Fader:
Code:
Option Explicit[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal lngWinIdx As Long) As Long
Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As LongPtr, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Dim hWnd As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal lngWinIdx As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Dim hWnd As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Public Sub Fade(ByVal lStep As Long, Optional ByVal lStart As Long = 0, Optional ByVal lStop As Long = 100)
Dim lTemp As Long
Dim lCounter As Long
lCounter = (lStop - lStart) \ lStep
If lCounter * lStep < lStart - lStop Then lCounter = lCounter + 1
For lTemp = 1 To lCounter
DoEvents
Sleep 20
Call SemiTransparent(lStart + lTemp * lStep)
DoEvents
Next lTemp
End Sub
Public Sub SemiTransparent(ByVal intLevel As Integer)
Dim lngWinIdx As Long
lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
SetLayeredWindowAttributes hWnd, 0, 255 * (intLevel / 100), LWA_ALPHA
End Sub
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Public Property Get FormWindowHandle() As LongPtr
FormWindowHandle = hWnd
End Property
Public Property Let FormWindowHandle(ByVal lFormWindowHandle As LongPtr)
hWnd = lFormWindowHandle
End Property
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Public Property Get FormWindowHandle() As Long
FormWindowHandle = m_hWnd
End Property
Public Property Let FormWindowHandle(ByVal lFormWindowHandle As Long)
m_hWnd = lFormWindowHandle
End Property
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
BackgroundTest userform
Code:
Option Explicit
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, ByVal lngWinIdx As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
Dim hWnd As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal lngWinIdx As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Dim hWnd As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Dim Running As Boolean
Dim oFader As FormFader
Private Sub UserForm_Initialize()
Dim Style As Long
hWnd = FindWindow(vbNullString, Me.Caption)
Set oFader = New FormFader
oFader.FormWindowHandle = hWnd
Style = GetWindowLong(hWnd, -16) And Not &HC00000
SetWindowLong hWnd, -16, Style
DrawMenuBar hWnd
oFader.SemiTransparent 0
End Sub
Private Sub UserForm_activate()
If Running Then Exit Sub
With Me
.Height = Application.Height
.Width = Application.Width
.Left = Application.Left
.Top = Application.Top
End With
Running = True
oFader.Fade 5, 0, 60
Call ShowSecondForm
Unload Me
End Sub
Private Sub Userform_QueryClose(Cancel As Integer, closemode As Integer)
oFader.Fade -5, 60, 0
End Sub
Sub ShowSecondForm()
UserForm1.Show
End Sub
What I would like is to amend it so it fades in the following userforms as well:
NewProduct
Password
Search
Hope this all makes sense.
Kind Regards
Dan