[英]Change event code generates Run-Time error '28' out of stack space
This code worked in Excel 2010, however I now have Excel 2013. 该代码在Excel 2010中有效,但是现在有了Excel 2013。
The error is 错误是
Run-Time error '28' out of stack space, Run-Time error '2147417848 (80010108)': Method 'Value' of object 'Range' Failed
堆栈空间不足,运行时错误'28',运行时错误'2147417848(80010108)':对象'范围'的方法'值'失败
Code is as follows. 代码如下。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range, rv As Long
If Not Intersect(Target, Range("C77:AD81")) Is Nothing Then
Set rng = Intersect(Target, Range("C77:AD81"))
For Each r In rng
'Peak Flow Doctor Warning
Select Case r.Value
Case 180
MsgBox "''PEAK FLOW CRITICAL AT 180L/MIN''" & vbCrLf & "''PREDNISONE PROBABLY REQUIRED''" & vbCrLf & "''MAKE DOCTOR'S APPOINTMENTS ASAP''", vbInformation, "WARNING"
Case 120
MsgBox "''PEAK FLOW CRITICAL AT 120L/MIN''" & vbCrLf & "''MAKE URGENT DOCTOR'S APPOINTMENTS''" & vbCrLf & "''OR GO TO A&E IMMEDIATELY''", vbInformation, "CRITICAL WARNING"
Case Is >= 525
MsgBox "''CHECK OR TEST PEAK FLOW METER''" & vbCrLf & "''IT MAY BE FAULTY AND GIVING FALSE HIGH's''", vbInformation, "WARNING"
End Select
Next r
End If
'OraKinetics needs to change to (Target, Range("C95:AD95"))
If Not Intersect(Target, Range("C93:AD93")) Is Nothing Then
Set rng = Intersect(Target, Range("C93:AD93"))
For Each r In rng
'Weight Gain Warning
Select Case r.Value
Case 90
MsgBox "''LIKELY TO EXACERBATE COPD SYMPTOMS''" & vbCrLf & "''CHRONIC ASTHMA OR EMPHYSEMA PROBABLE''", vbCritical, "WARNING"
Case 95
MsgBox "''IF SWELLING IN ANKLES PROBABLE FLUID RETENTION''" & vbCrLf & "''POSSIBILITY OF HEART FAILURE IF UNATTENDED''", vbCritical, "CRITICAL WARNING"
End Select
Next r
End If
'Change Best Peak Flow and Date Achieved
ActiveSheet.Unprotect Password:="asthma"
If Range("R7").Value > Range("F7").Value Then
Range("R7").Select
Selection.Copy
Range("F7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K7") = Date
Application.CutCopyMode = False
ActiveSheet.Protect Password:="asthma", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End Sub
If you're creating changes inside a _Change
event then you need to disable events before the change to prevent an infinite loop. 如果要在
_Change
事件中创建更改,则需要在更改之前禁用事件以防止无限循环。
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="asthma"
If Range("R7").Value > Range("F7").Value Then
Range("R7").Select
Selection.Copy
Range("F7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K7") = Date
Application.CutCopyMode = False
ActiveSheet.Protect Password:="asthma", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Application.EnableEvents = True
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.