在VBA中我們有時需要一些特殊形狀的窗體來美化我們的程序，比如說幾個幾何形狀的組合樣式的窗體。那我們就來作一個同心圓形狀的窗體： 本示例主要運用 API 函數來定制化Excel中的用戶窗體，使其顯示特殊形狀

附件下載：

點擊鏈接從百度網盤下載

操作如下：

?在Excel的VBE窗口中插入一個用戶窗體，將其命名為EspecialForm。然后再添加一個模塊。然后在窗體和模塊中添加后面所列代碼。

?在工作薄中的任意工作表中添加一窗體按鈕控件，將指定其設置宏為ShowForm。其供示范之用

具體代碼：

"mdEspecial"模塊代碼

Sub btnShowEspecial_Click()
frmEspecial.Show
End Sub

"frmEspecial" 窗體代碼

Option Explicit
'**********************************
'---此模塊主要是創建了一個圓環窗體---
'**********************************
'以下聲明API函數
#If Win64 Then '64位
'視情況向和窗體發送消息
Private Declare PtrSafe Function SendMessage _
Lib "user32" _
Alias "SendMessageA" ( _
ByVal Hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
lParam As Any) _
As LongPtr
'創建一個內切于矩形的橢圓
Private Declare PtrSafe Function CreateEllipticRgn _
Lib "gdi32" ( _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) _
As LongPtr
'以特定的方式合并區域
Private Declare PtrSafe Function CombineRgn _
Lib "gdi32" ( _
ByVal hDestRgn As LongPtr, _
ByVal hSrcRgn1 As LongPtr, _
ByVal hSrcRgn2 As LongPtr, _
ByVal nCombineMode As Long) _
As Long
'給窗體設置區域，而舍棄此區域外的其他區域
Private Declare PtrSafe Function SetWindowRgn _
Lib "user32" ( _
ByVal Hwnd As LongPtr, _
ByVal hRgn As LongPtr, _
ByVal bRedraw 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 ReleaseCapture _
Lib "user32" () _
As Long
#Else
'視情況向和窗體發送消息
Private Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" ( _
ByVal Hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
'創建一個內切于矩形的橢圓
Private Declare Function CreateEllipticRgn _
Lib "gdi32" ( _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) _
As Long
'以特定的方式合并區域
Private Declare Function CombineRgn _
Lib "gdi32" ( _
ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, _
ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) _
As Long
'給窗體設置區域，而舍棄此區域外的其他區域
Private Declare Function SetWindowRgn _
Lib "user32" ( _
ByVal Hwnd As Long, _
ByVal hRgn As Long, _
ByVal bRedraw 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 ReleaseCapture _
Lib "user32" () _
As Long
#End If
'聲明常數及變量
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE_MOUSE = &HF012&
Private Const RGN_XOR = 3 '兩個源區域并集之外的部分
#If Win64 Then '64位
Dim FHwnd As LongPtr
Dim FRgn1 As LongPtr
Dim FRgn2 As LongPtr
#Else
Dim FHwnd As Long
Dim FRgn1 As Long
Dim FRgn2 As Long
#End If
'窗體雙擊
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Unload Me
End Sub
'窗體初始化
Private Sub UserForm_Initialize()
FRgn1 = CreateEllipticRgn(10, 40, 200, 230) '創建一個圓
FRgn2 = CreateEllipticRgn(30, 60, 180, 210) '創建一個圓
CombineRgn FRgn1, FRgn1, FRgn2, RGN_XOR '合并兩個圓，取其不相交的部分
FHwnd = FindWindow(vbNullString, Me.Caption) '查找窗體句柄
SetWindowRgn FHwnd, FRgn1, 1 '設置窗體區域，一個圓環
End Sub
'窗體鼠標按下
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
ReleaseCapture '釋放鼠標
SendMessage FHwnd, WM_SYSCOMMAND, SC_MOVE_MOUSE, 0
End Sub