如何设置让VBA窗体置顶

987654321

VBA窗体置顶是什么意思?是最前面吗?

987654321

窗体最前面:
把以下代码复制到窗体中
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Dim hWnd As Long
Private Sub UserForm_Initialize()
    hWnd = FindWindow(vbNullString, Me.Caption)
    SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

fdd

学习，我猜只能用API函数解决了。学习！

987654321

模块1加入以下代码:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
    (ByVal myHwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal myHwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal myHwnd As Long) As Long
Public Const GWL_STYLE = -16&
Public Const WS_SYSMENU = &H80000

窗体中加入:
Private Sub UserForm_Initialize()
    Dim myHwnd  As Long
    Dim lngNewLong As Long
    Dim myRc As Long
    Dim myClassName As String
    myClassName = "ThunderDFrame"
    myHwnd = FindWindow(myClassName, Me.Caption)
    lngNewLong = GetWindowLong(myHwnd, GWL_STYLE)
    myRc = SetWindowLong(myHwnd, GWL_STYLE, _
        lngNewLong And (Not WS_SYSMENU))
    myRc = DrawMenuBar(myHwnd)
End Sub

qifenghome

请教大师 如何屏蔽窗体关闭按钮啊 谢谢！！

qifenghome

谢谢大师指点 达到了想要的效果

qifenghome

这个代码屏蔽的是所有按钮 但我想保留最大 最下化按钮啊

987654321

窗体的最大化\最小化按钮是要另外添加的

小fisher

原帖由 qifenghome 于 2009-5-22 21:30 发表
这个代码屏蔽的是所有按钮 但我想保留最大 最下化按钮啊

下面的代码添加最大、最小化按钮，并且让关闭按钮不可用（在窗口上双击左键关闭）

1. 
   
2. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
3. Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
   
4. Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
   
5. Private Const MF_BYPOSITION = &H400&
   
6. Private Const MF_DISABLED = &H2&
   
7. Private Const MF_GRAYED = &H1&
   
8. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
   
9. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
10. Private Const GWL_STYLE = (-16)
    
11. Private Const WS_MAXIMIZEBOX = &H10000
    
12. Private Const WS_MINIMIZEBOX = &H20000
    
13. 
    
14. Private Sub UserForm_Initialize()
    
15.     Dim hwnd As Long
    
16.     Dim hMenu As Long
    
17.     Dim lStyle As Long
    
18.     hwnd = FindWindow(vbNullString, Me.Caption)
    
19.     lStyle = GetWindowLong(hwnd, GWL_STYLE)
    
20.     lStyle = lStyle Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX
    
21.     SetWindowLong hwnd, GWL_STYLE, lStyle
    
22.     hMenu = GetSystemMenu(hwnd, 0)
    
23.     EnableMenuItem hMenu, 6, MF_BYPOSITION Or MF_DISABLED Or MF_GRAYED
    
24. End Sub
    
25. 
    
26. Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
27.     Unload Me
    
28. End Sub
    

复制代码

fdd

小Fisher，我又从您那儿尝到了一些API的函数了！今天早晨这么早就起来也算没有白忙活了（白天有事，只有少睡觉才能挤出一点儿时间来哟）！挺高兴的。我准备学API从研究小fisher您的作品开始，因为您的作品很喜欢用API函数，把您的作品弄明白了，我想大多数常用的API就明白了。对吗？不过，中间肯定会有很多地方不理解的，到时少不了要来麻烦您哟，您可不要嫌烦！（我会很知趣的，尽量自己去想，哪怕需要一天、两天或者很多天，直到确实无法解决再来问您。）