为什么我无法隐藏进度栏上的标题栏?



我正在尝试使用这里的一些代码。 我已经检查了一些编程论坛,似乎还可以。但是我在显示用作进度条的用户表单时收到 438 错误。我对如何使用库一无所知(这是我第一次(。

标头代码:

Option Explicit
Option Private Module
' FROM https://wellsr.com/vba/2017/excel/beautiful-vba-progress-bar-with-step-by-step-instructions/
Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
#If VBA7 Then
Public Declare PtrSafe Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare PtrSafe Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare PtrSafe Function DrawMenuBar _
Lib "user32" ( _
ByVal hWnd As Long) As Long
Public Declare PtrSafe Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
#Else
Public Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar _
Lib "user32" ( _
ByVal hWnd As Long) As Long
Public Declare Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
#End If

隐藏标题栏的过程

Sub HideTitleBar(frm As Object)
Dim lngWindow As Long
Dim lFrmHdl As Long
lFrmHdl = FindWindowA(vbNullString, frm.Caption)
lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
lngWindow = lngWindow And (Not WS_CAPTION)
Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
Call DrawMenuBar(lFrmHdl)
End Sub

当我尝试显示用户表单时,我在线收到一个恒定的 438 错误:lFrmHdl = FindWindowA(vbNullString, frm.Caption)。我没有找到原因。

我创建的宏来调用此用户窗体:

Sub Delete_Zero()
Dim LastRow As Long
Dim LastCol As Long
Dim i As Long
Dim j As Long
Dim pctdone As Single

'(Step 1) Display your Progress Bar
ufProgress.LabelProgress.Width = 0
ufProgress.Show vbModeless
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For i = 1 To LastRow
For j = 1 To LastCol
If Cells(i, j).Value2 = 0 Or Cells(i, j).Value2 = "" Then
Cells(i, j).ClearContents
End If
Next j
'(Step 2) Update Progress Bar
pctdone = i / LastRow
With ufProgress
.LabelCaption.Caption = "Processing Row " & i & " of " & LastRow
.LabelProgress.Width = pctdone * (.FrameProgress.Width)
End With
ufProgress.Repaint
'(Step 3) Unload Progress Bar
If i = LastRow Then Unload ufProgress
Next i
End Sub

任何帮助将不胜感激。

更新 1: 我忘了在用户表单中附加代码:

Private Sub UserForm_Initialize()
Me.Height = Me.Height - 10
HideTitleBar.HideTitleBar Me
End Sub

如果您只想阻止用户单击X关闭按钮,则无需跳过一堆箍来隐藏标题栏。只需捕获事件并取消请求即可。

在用户窗体代码模块中,粘贴以下代码:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = True
End Sub

仅此而已。


想让它更精致吗?好吧,您可以先提示用户。

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
if Inputbox("If you are sure you want to stop the procedure, please type the " & _
"word 'STOP'") = "STOP" then
Cancel = False
Else
Cancel = True
End If
End Sub

最新更新