我正在使用Excel 2013，并且遇到了一个让我疯狂的SelectionChange事件的问题。我想知道是否有人可以帮助我。我已经待了这么久（超过一周！）我可能会遗漏那些外面很容易看到的东西。以下代码在Excel 2007和2010中运行良好。
最初，当您激活页面时，代码会立即将您恢复到调用页面（在此主题菜单中）。第二次代码正常工作。在某个阶段，只需选择新单元格，它就会将您还原到另一页面。在我的实例中，它将我带回主菜单页面。
在我的问题中调用了三个例程（1）选择更改事件，（2）SetHighlightRows1（ByVal目标为范围），（3）MinRowsHeight_ActiveCell
感谢您的帮助/ sglxl
Option Explicit
Private Declare Function LockWindowUpdate Lib "USER32" _
(ByVal hwndLock As Long) As Long
----------------------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Msg, Style, Title, Response
' Similar to ScreenUpdating but this locks the Shapes from continuous Flickering
LockWindowUpdate Application.hWnd
' Initialise
ActiveSheet.Unprotect Password:=pw
Application.ScreenUpdating = False
' Highlight selected rows
Call SetHighlightRows1(ActiveCell)
' Reset ScreenUpdating to False
Application.ScreenUpdating = False
' Headings in all sheets set to Max 53
' Build Message
Msg = "You cannot access this area!"
Style = vbOKOnly + vbInformation
Title = "Company Secretary"
On Error Resume Next
' Limit access area so that row heights remain constant
If Not (Intersect(Target, Range("A1:O8")) Is Nothing) Or Not (Intersect(Target, Range("A1011:O1011")) Is Nothing) Then
Response = MsgBox(Msg, Style, Title)
Range("ptrCursor").Select
GoTo CleanUp:
Else
Target.Select
End If
' Set Row Height
' EnableEvents set to TRUE
Call MinRowsHeight_ActiveCell
' Unprotect AkSht as MinRowsHeight_ActiveCell set Protect = True
ActiveSheet.Unprotect Password:=pw
Rows(3).EntireRow.RowHeight = 53
CleanUp:
' CleanUp
ActiveSheet.Protect Password:=pw, AllowFiltering:=True
Application.ScreenUpdating = True
' Unlock the window updating in the end by passing a null to the LockWindowUpdate API function.
LockWindowUpdate 0
End Sub
' ---------------------------------------------------------------------------------
'----------------------------------------------------------------
Public Sub SetHighlightRows1(ByVal Target As Range)
'----------------------------------------------------------------
Dim MyRng As Range
Dim TargetCol
Dim TargetRow
Dim BeginColumn As Long
Dim EndColumn As Long
Dim BeginRow As Long
' Initialise
' Disable Events before SelectionChange occurs. There may be other events that
' may Trigger the SelectionChange
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
' Define Row and Column ranges to make routine dynamic
TargetCol = Target.Column
TargetRow = Target.Row
BeginColumn = ActiveSheet.Range("ptrColumnBegin").Column
EndColumn = ActiveSheet.Range("ptrColumnEnd").Column - 1
BeginRow = ActiveSheet.Range("ptrBeginCell").Row
' ***** Set Range parameters *****
Set MyRng = Range(Cells(TargetRow, BeginColumn), Cells(TargetRow, EndColumn))
' Initialise
' Disable Events before SelectionChange occurs. There may be other events that
' may Trigger the SelectionChange
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error GoTo CleanUp
If TargetCol > EndColumn Then GoTo CleanUp
' ***** Set range limits *****
' ActiveSheet.Range("ptrEndCell").Row - 1 - This will ensure that if the user inserts additionalRows
' The highlighter bar will follow to include the additional Rows
If TargetRow < BeginRow Or TargetRow > ActiveSheet.Range("ptrEndCell").Row - 1 Then GoTo CleanUp
' ***** End Range Limits *****
Application.Cells.FormatConditions.Delete
' Highlight Columns
With MyRng
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
' .Color = RGB(192, 0, 0) ' Seaxl Red
.Color = RGB(83, 141, 213) ' Dark Blue
.Color = RGB(0, 51, 204) ' Dark Blue
End With
' .FormatConditions(1).Interior.Color = RGB(225, 234, 204) ' Green
' .FormatConditions(1).Interior.Color = RGB(220, 230, 241) ' Light Blue
.FormatConditions(1).Interior.Color = RGB(248, 248, 248) ' Light Grey
End With
CleanUp:
' CleanUp
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
' ---------------------------------------------------------------------------------
Sub MinRowsHeight_ActiveCell()
'Initialise
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:=pw
Application.EnableEvents = False
' Only Visible Cells are set to min height
ActiveSheet.Range("tblDatabaseSort").SpecialCells(xlCellTypeVisible).RowHeight = 22.5
' Adjust only the ActiveCell Row height to AutoFit
ActiveCell.EntireRow.AutoFit
If ActiveCell.EntireRow.RowHeight < 22.5 Then
ActiveCell.EntireRow.RowHeight = 22.5
End If
' CleanUp
Application.ScreenUpdating = True
ActiveSheet.Protect Password:=pw
Application.EnableEvents = True
End Sub
答案 0 :(得分：0)
我一直在审核你的一些代码，我的笔记如下：
我在excel 2013上设置了你的代码并运行它。 （我根据需要添加了命名范围）。我通过使用LockWindowUpdate和Application.ScreenUpdating以及Application.EnableEvents注释掉所有代码行来查看代码。代码工作正常。但是，当我重新添加它们时，代码无法按预期工作。
当我在立即窗口中输入Application.EnableEvents = true时，您的代码将重新开始工作。
我建议你这样做，然后逐渐重新添加这些内容，并清楚发生了什么。我猜测 Application.EnableEvents正在关闭并保持关闭状态。请参阅下面的poitn -1，其中显示了可能发生的情况......（可能导致它的错误，我不知道）。
我认为您需要改进错误处理，以便报告更多信息。
感谢您发布此消息，我发现您的代码非常丰富且有趣并且学习了主要技术，即使用条件格式将格式临时应用于单元格。好的。
这是我注意到的事情
-1。当调用MinRowsHeight_ActiveCell时，如果出现错误（例如，命名范围tblDatabaseSort不存在，ETC！），它将引发错误并跳过清理，其中Application.EnableEvents = True将其打开。因此，请将其关闭！
添加活动表格。在前面：范围（和细胞（ 目前这是隐含的情况。
'*****设置范围参数***** 设置MyRng =范围（单元格（TargetRow，BeginColumn），单元格（TargetRow，EndColumn））
如果未定义命名范围，代码将继续...
On Error Resume Next
'定义行和列范围以使例程动态化 TargetCol = Target.Column TargetRow = Target.Row BeginColumn = ActiveSheet.Range（“ptrColumnBegin”）。列 EndColumn = ActiveSheet.Range（“ptrColumnEnd”）。列 - 1 BeginRow = ActiveSheet.Range（“ptrBeginCell”）。行
您的代码中不必要地重复此代码段 - 我认为
'初始化 '在SelectionChange发生之前禁用事件。可能还有其他事件 '可能会触发SelectionChange Application.ScreenUpdating = False Application.EnableEvents = False
Application.Cells.FormatConditions.Delete
'突出显示列 有了MyRng .FormatConditions.Delete
我会编写ActiveSheet.Cells.FormatConditions.Delete，但你的代码做同样的事情。 后面的代码（上面）再次删除它们，这是不必要的。
（PS。如果您在具有其他格式条件的工作表上使用此功能，则需要更智能地删除格式条件）