在Excel中當我們有時需要一些特殊形狀的窗體，如果是幾何形狀組合的窗體，那么我們可以使用定制化窗體之特殊形狀窗體一：幾何形狀組合窗體中的方法來實現。但有時我們需要顯示一個文字窗口，或者顯示一幅鏤空圖畫的窗體，或者任意形狀的窗體，那又怎么做呢？

制作思路：

?你首先需要準備一張圖片，在圖片上畫出你需要顯示的圖形或文字等，然后將圖片上需要透明的部分設置為同一種顏色（在示例中我用的是白色）。之后在窗體初始化時載入此圖片，并將窗體的PictureSizeMode屬性設置為1fmPictureSizeModeStretch。

?然后在窗體初始化時用FindWindow取得窗體的句柄，再用GetWindowLong取得窗體的樣式位和拓展樣式位。用SetWindowLong設置窗體新的樣式位和拓展樣式位（無標題欄和邊框）。以達到去除窗體標題欄和邊框的效果。

?接下來最重要的部分就是使我們不需要的那部分窗體透明。這里我們將用到一個API函數SetLayeredWindowAttributes。我們將函數中的參數crKey設為你需要透明部分的顏色。參數bAlpha設為0~255之間的任意值（這里將忽略此參數）。參數dwFlags設為LWA_COLORKEY，以達到使窗體鏤空顯示的效果。

附件下載：

點擊鏈接從百度網盤下載

操作如下：

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

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

具體代碼：

"mdArbitrary"模塊代碼

?

'---工作表按鈕調用---
Sub ShowForm()
ArbitraryForm.Show 0
End Sub

"ArbitraryForm" 窗體代碼

'****************************************
'---此模塊創建了一個可以是任意形狀的窗口---
'****************************************
Option Explicit
'以下聲明API函數
#If Win64 Then '64位
'設置窗體透明度或透明樣式
Private Declare PtrSafe Function SetLayeredWindowAttributes _
Lib "user32" ( _
ByVal Hwnd As LongPtr, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) _
As LongPtr
'取得窗體樣式位
Private Declare PtrSafe Function GetWindowLong _
Lib "user32" _
Alias "GetWindowLongPtrA" ( _
ByVal Hwnd As LongPtr, _
ByVal nIndex As Long) _
As LongPtr
'查找窗口
Private Declare PtrSafe Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As LongPtr
'設置窗體樣式位
Private Declare PtrSafe Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongPtrA" ( _
ByVal Hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) _
As LongPtr
'繪制窗體標題欄
Private Declare PtrSafe Function DrawMenuBar _
Lib "user32" ( _
ByVal Hwnd As LongPtr) _
As Long
'視情況向和窗體發送消息
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 ReleaseCapture _
Lib "user32" () _
As Long
#Else
'設置窗體透明度或透明樣式
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 GetWindowLong _
Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex 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 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 Function SendMessage _
Lib "user32" _
Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
'釋放鼠標控制
Private Declare Function ReleaseCapture _
Lib "user32" () _
As Long
#End If
#If Win64 Then '64位
Private hWndForm As LongPtr
Private FIstype As LongPtr
#Else
Private hWndForm As Long
Private FIstype As Long
#End If
'以下定義常數和變量
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20) '拓展窗口樣式
Private Const LWA_COLORKEY = &H1
Private Const GWL_STYLE = (-16) '窗口樣式
Private Const WS_CAPTION = &HC00000
Private Const WS_EX_DLGMODALFRAME = &H1&
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE_MOUSE = &HF012&
'---窗體雙擊---
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Unload Me
End Sub
'---窗體初始化---
Private Sub UserForm_Initialize()
On Error Resume Next
'設置窗體背景圖片, 這里為了方便我使用的是工作表中圖片控件儲存的圖片，可以用下面第三行的語句載入自己準備好的圖片
Me.Picture = ThisWorkbook.Worksheets("源圖").Image1.Picture
'設置窗體背景圖片時也可以用以下語句載入圖片
'Me.Picture = LoadPicture(ThisWorkbook.Path & "\創作.bmp")
If Err <> 0 Then
MsgBox "窗體背景圖片未找到，請將壓縮包內圖片和此文檔放置在同一目錄下", vbCritical, "錯誤"
End
End If
'設置窗體尺寸模式
Me.PictureSizeMode = fmPictureSizeModeStretch
'查找窗體句柄
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
'取得窗體樣式
FIstype = GetWindowLong(hWndForm, GWL_STYLE)
'窗體樣式：原樣式無標題
FIstype = FIstype And Not WS_CAPTION
'重設窗體樣式
SetWindowLong hWndForm, GWL_STYLE, FIstype
'取得窗體拓展樣式
FIstype = GetWindowLong(hWndForm, GWL_EXSTYLE)
'窗體拓展樣式：無邊框，分層
FIstype = FIstype And Not WS_EX_DLGMODALFRAME Or WS_EX_LAYERED
'重設窗體拓展樣式位
SetWindowLong hWndForm, GWL_EXSTYLE, FIstype
'重繪窗體標題欄
DrawMenuBar hWndForm
'設置窗體背景白色部分為透明，這里的RGB色設成你希望透明的顏色
SetLayeredWindowAttributes hWndForm, RGB(255, 255, 255), 255, LWA_COLORKEY
End Sub
'---鼠標按下---
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
'釋放控制
ReleaseCapture
'向窗體發送消息
SendMessage hWndForm, WM_SYSCOMMAND, SC_MOVE_MOUSE, 0
End Sub