多个Excel注释和验证。添加奇怪的行为

时间:2015-07-27 15:41:12

标签: excel vba excel-vba

我有一个非常复杂的Excel VBA项目,其中包含多个注释和验证,并且几天前遇到了一些奇怪的问题。 碰巧在向工作表中添加了一些额外的注释后,在验证单元格中验证后,在验证后立即执行了一些随机单元格的注释形状。 经过调查和一些测试后,我能够使用以下代码在空工作表上复制问题:

Sub CommentsBug()
Dim rng As Range
Dim i As Long
Dim rngItem As Range

Set rng = ActiveSheet.Range("A1:C25000")
For Each rngItem In rng
    rngItem.Cells(1, 1).Value = i
    If rng.Comment Is Nothing Then rngItem.AddComment
    rngItem.Comment.Text "Comment # " & i
    i = i + 1
Next

ActiveSheet.Range("E1").Activate
ActiveCell.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1,2,3,4,5"

End Sub

在代码执行后,我有一个随机单元格出现在验证单元格内的评论框(由于缺少代表而无法放置截图)。如果我将最后处理的单元格更改为C20000,则不会出现问题。 该系统是Excel 2013 32位Office,Win 7 64。 我会很高兴任何建议和解决方法。

更新和快速修复:

在BruceWayne的帮助下,最终可以快速修复(见下面的批准答案)。以某种方式将For Each语句更改为For并处理单独的单元格范围。 这似乎是一个错误,请参阅John Coleman和BruceWayne关于其具体细节的重要评论。希望来自微软的人会遇到它,我也在answers.microsoft.com发布了问题。 只要我已经有一个充满数据的工作表,以下注释更新代码为我工作,以摆脱出现的评论框(大张纸需要惊人的大量时间 - 很多小时,把你的行数/循环中的列而不是3000/500,如果您没有单元保护,请删除保护/取消保护语句):

Public Sub RestoreComments()
Dim i As Long
Dim j As Long
Dim rng As Range
Dim commentString As String

Application.ActiveSheet.Unprotect
Application.ScreenUpdating = False
For i = 1 To 3000
    For j = 1 To 500
        Set rng = Cells(i, j)
          If Not rng.comment Is Nothing Then
            commentString = rng.comment.Shape.TextFrame.Characters.Text
            'commentString = GetStringFromExcelComment(rng.comment)
            'see Update #2
            rng.comment.Delete
            rng.AddComment
            rng.comment.Text commentString
            rng.comment.Shape.TextFrame.AutoSize = True
          End If
    Next j
Next i
Application.ScreenUpdating = True    
Application.ActiveSheet.Protect userinterfaceonly:=True

End Sub

更新#2

在执行恢复注释时,我还遇到了另一个使用comment.Shape.TextFrame.Characters.Text时注释字符串超过255个字符的转换问题。如果您有长注释,请使用以下代码返回注释字符串:

'Addresses an Excel bug that returns only first 255 characters
'when performing comment.Shape.TextFrame.Characters.Text
Public Function GetStringFromExcelComment(comm As comment) As String
Dim ifContinueReading As Boolean
Dim finalStr As String, tempStr As String
Dim i As Long, commStrLimit As Long

ifContinueReading = True
commStrLimit = 255
i = 1
finalStr = ""

Do While ifContinueReading
    'Error handling addresses situation
    'when comment length is exactly the limit (255)
    On Error GoTo EndRoutine
    tempStr = comm.Shape.TextFrame.Characters(i, commStrLimit).Text
    finalStr = finalStr + tempStr
    If Len(tempStr) < commStrLimit Then
        ifContinueReading = False
    Else
        i = i + commStrLimit
    End If
Loop

EndRoutine: GetStringFromExcelComment = finalStr

End Function

在以下线程中找到了解决方案(略微更改以解决与限制完全匹配的字符串): Excel Comment truncated during reading

2 个答案:

答案 0 :(得分:3)

因此,在调整代码后,我发现如果更改For()循环,则可以停止显示注释。试试这个:

Sub CommentsBug()
Dim rng           As Range
Dim i             As Long
Dim rngItem       As Range
Dim ws            As Worksheet
Dim k As Integer, x As Integer

Set ws = ActiveSheet

Application.ScreenUpdating = False

Set rng = ws.Range("A1:C25000")

For k = 1 To 25000
    If i > 25000 Then Exit For

    For x = 1 To 3
        Set rngItem = Cells(k, x)
        Cells(k, x).Value = i
        If rng.Comment Is Nothing Then rngItem.AddComment
        rngItem.Comment.Text "Comment # " & i
        rngItem.Comment.Visible = False
        rngItem.Comment.Shape.TextFrame.AutoSize = True

        i = i + 1
    Next x
Next k

ws.Range("E1").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1,2,3,4,5"

Application.ScreenUpdating = True
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End Sub

注意:这可能需要一段时间才能运行,但它并没有像你那样弹出相同的随机评论。另外,至于为什么这个工作而另一个For()循环不胜,我不知道。我怀疑它与Excel使用验证的方式有关,而不是与代码有关(但这是纯粹的推测,也许其他人知道发生了什么)。

答案 1 :(得分:1)

这个kludge似乎有用(虽然不能保证底层的bug会在其他地方冒泡到表面)

Sub CommentsBug()
    Dim rng As Range
    Dim i As Long
    Dim rngItem As Range
    Dim kludgeIndex As Long
    Dim kludgeRange As Range
    Dim temp As String

    Application.ScreenUpdating = False
    Set rng = ActiveSheet.Range("A1:C25000")
    kludgeIndex = rng.Cells.Count Mod 65536
    For Each rngItem In rng
        rngItem.Cells(1, 1).Value = i
        If i = kludgeIndex Then Set kludgeRange = rngItem
        If rngItem.Comment Is Nothing Then rngItem.AddComment "Comment # " & i
        i = i + 1
    Next
    Application.ScreenUpdating = True
    ActiveSheet.Range("E1").Activate
    ActiveCell.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1,2,3,4,5"

    If Not kludgeRange Is Nothing Then
        Debug.Print kludgeRange.Address 'in case you are curious
        temp = kludgeRange.Comment.Text
        kludgeRange.Comment.Delete
        kludgeRange.AddComment temp
    End If
End Sub

当如上所述运行时,kludgeRange是单元格$ C $ 3155 - 显示9464.如果25000变为26000,kludgeRange变为单元格$ C $ 4155,显示12464.这是一个真正奇怪的kludge驱除鬼魂的地方从细胞E1你必须走几千个细胞。