在VBA中我们有时需要一些特殊形状的窗体来美化我们的程序，比如说几个几何形状的组合样式的窗体。那我们就来作一个同心圆形状的窗体： 本示例主要运用 API 函数来定制化Excel中的用户窗体，使其显示特殊形状
附件下载：
WPS之家wps.qiangguoshuo.com
点击链接从百度网盘下载
操作如下：
◾在Excel的VBE窗口中插入一个用户窗体，将其命名为EspecialForm。然后再添加一个模块。然后在窗体和模块中添加后面所列代码。
◾在工作薄中的任意工作表中添加一窗体按钮控件，将指定其设置宏为ShowForm。其供示范之用
具体代码：
"mdEspecial"模块代码
Sub btnShowEspecial_Click()frmEspecial.ShowEnd 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 = &H112Private Const SC_MOVE_MOUSE = &HF012&Private Const RGN_XOR = 3 '两个源区域并集之外的部分#If Win64 Then '64位Dim FHwnd As LongPtrDim FRgn1 As LongPtrDim FRgn2 As LongPtr#ElseDim FHwnd As LongDim FRgn1 As LongDim FRgn2 As Long#End If'窗体双击Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)Unload MeEnd 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, 0End Sub
转载声明：本站发布文章及版权归原作者所有，转载本站文章请注明文章来源！
