学习Excel技术,关注微信公众号:
excelperfect
本文将给出一段VBA代码,实现在加载用户窗体时逐步显现以及在关闭用户窗体时逐渐淡出的效果,如下图1所示。
图1
第1步:创建示例用户窗体
如下图2所示,我们简单地创建了一个用户窗体,在其中放置了标签、文本框、复选框和按钮控件。
图2
第2步:添加代码
在用户窗体中单击鼠标右键,选择快捷菜单中的“查看代码”命令。在用户窗体模块中输入下面的代码:
'在用户窗体模块中放置下面的代码
#If VBA7 Then
Private Declare PtrSafe Function FindWindowLib "user32" Alias "FindWindowA" (ByVal lpClassName AsString, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe FunctionGetWindowLong Lib "user32" Alias "GetWindowLongA" (ByValhwnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe FunctionSetWindowLong Lib "user32" Alias "SetWindowLongA" (ByValhwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBarLib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe FunctionSetLayeredWindowAttributes Lib "user32" (ByVal hwnd As LongPtr, ByValcrKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
#Else
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 DrawMenuBar Lib"user32" ( _
ByVal hwnd As Long) As Long
Private Declare FunctionSetLayeredWindowAttributes Lib "user32" ( _
ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
#End If
'代表标题栏的常量
Private Const GWL_STYLE As Long= (-16) '窗口样式的偏移量
Private Const GWL_EXSTYLE AsLong = (-20) '窗口扩展样式的偏移量
Private Const WS_CAPTION AsLong = &HC00000
'用于添加标题栏的样式
Private ConstWS_EX_DLGMODALFRAME As Long = &H1 '控制是否窗口有图标
'透明度常量
Private Const WS_EX_LAYERED =&H80000
Private Const LWA_COLORKEY =&H1 '用于在窗体上淡化某种颜色的色度键
Private Const LWA_ALPHA =&H2 '仅在想要淡化整个用户窗体时才需要
'暂停
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib"kernel32" (ByVal dwMilliseconds As LongPtr)'64位Excel版本
Dim formhandle As LongPtr
#Else
Private Declare Sub Sleep Lib"kernel32" (ByVal dwMilliseconds As Long)'32位Excel版本
Dim formhandle As Long
#End If
Private SubUserForm_Initialize()
'在窗体加载之前强制窗体完全透明
formhandle = FindWindow(vbNullString,Me.Caption)
SetWindowLong formhandle, GWL_EXSTYLE,GetWindowLong(formhandle, GWL_EXSTYLE) Or WS_EX_LAYERED
SetOpacity (0)
End Sub
Private Sub UserForm_Activate()
'HideTitleBarAndBorder Me '隐藏标题栏和边框
FadeUserform Me, True '窗体逐渐显现
End Sub
Private SubUserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
FadeUserform Me, False '窗体逐步淡化
End Sub
Sub FadeUserform(frm As Object,Optional FadeIn As Boolean = True)
'默认为窗体逐渐显现.
'将第2个参数设置为False使窗体逐步淡化.
Dim iOpacity As Integer
formhandle = FindWindow(vbNullString,Me.Caption)
SetWindowLong formhandle, GWL_EXSTYLE,GetWindowLong(formhandle, GWL_EXSTYLE) Or WS_EX_LAYERED
'将用户窗体透明度设置为等于iOpacity(0到255)中的任何值
If FadeIn = True Then '逐渐显现
For iOpacity = 0 To 255 Step 15
Call SetOpacity(iOpacity)
Next
Else '逐渐淡化
For iOpacity = 255 To 0 Step -15
Call SetOpacity(iOpacity)
Next
Unload Me '一旦淡化卸载用户窗体
End If
End Sub
Sub SetOpacity(Opacity AsInteger)
SetLayeredWindowAttributes formhandle,Me.BackColor, Opacity, LWA_ALPHA
Me.Repaint
Sleep 50
End Sub
Sub HideTitleBarAndBorder(frmAs Object)
'隐藏标题栏和窗体周边的边框
#If VBA7 Then
Dim lngWindow As LongPtr
Dim lFrmHdl As LongPtr
#Else
Dim lngWindow As Long
Dim lFrmHdl As Long
#End If
lFrmHdl = FindWindow(vbNullString,frm.Caption)
'创建窗口并设置窗口,直到删除窗口的标题、标题栏和周边的边框
lngWindow = GetWindowLong(lFrmHdl,GWL_STYLE)
lngWindow = lngWindow And (Not WS_CAPTION)
SetWindowLong lFrmHdl, GWL_STYLE, lngWindow
lngWindow = GetWindowLong(lFrmHdl,GWL_EXSTYLE)
lngWindow = lngWindow And NotWS_EX_DLGMODALFRAME
SetWindowLong lFrmHdl, GWL_EXSTYLE,lngWindow
DrawMenuBar lFrmHdl
End Sub
第3步:运行用户窗体
在VBE中的用户窗体界面,按F5或者单击菜单上的“运行”命令,运行用户窗体,结果如本文前面的图1所示。此时,用户窗体逐渐显现,当单击右上角的X按钮关闭用户窗体时,用户窗体逐渐淡出,
附加:自定义窗体透明度
如果只想透明显示用户窗体,而不想淡入淡出用户窗体,例如将用户窗体的透明度设置为50%并放置在那里,那么首先要注释掉或删除掉在UserForm_Activate和UserForm_QueryClose中的FadeUserform Me语句。然后,在某个过程中例如UserForm_Initialize过程中添加下面的语句:
formhandle =FindWindow(vbNullString, Me.Caption)
SetWindowLong formhandle,GWL_EXSTYLE, GetWindowLong(formhandle, GWL_EXSTYLE) Or WS_EX_LAYERED
SetOpacity (128) '范围从0(全透明)至255(完全不透明)
其中,SetOpacity语句很重要。用户窗体的不透明度可以在0至255之间变化,其中0表示完全透明,255表示完全不透明。这里选择128,其透明率约为50%,效果如下图3所示。
图3
注:本技巧学自wellsr.com,本文进行了整理和修改。



