RibbonUI的PowerPoint加载项丢失 [英] PowerPoint Add-In Loss of RibbonUI

问题描述

我一直在努力找出分布在大约40个最终用户中的PPT加载项中的错误原因.

I have been struggling to identify the cause of an error in a PPT Add-in that is distributed across about 40 end users.

问题:功能区状态丢失/功能区对象丢失.

Problem: loss of the ribbon state/loss of the ribbonUI object.

对于某些用户，最终Rib对象将变为Nothing.

For some users, eventually the Rib object becomes Nothing.

用户向我保证，它们不会出现任何运行时错误或脚本错误(来自我们也通过此加载项调用的COM对象).如果用户点击End，则未处理的错误可能会导致状态丢失.

Users assure me they are not getting any run-time errors nor script errors (from COM object that we also invoke through this add-in). An unhandled error, if user hits End would expectedly cause the state loss.

没有一个用户能够可靠地重现导致观察到的故障的方案.这就是很难进行故障排除的原因.我希望没有希望的地方是我很想念的东西，或者是我没想到的.

None of the users have been able to reliably reproduce the scenario which causes the observed failure. This is what makes it very difficult to troubleshoot. I am hoping against hope that there is something obvious that I'm missing, or that I didn't anticipate.

我目前如何处理损失或RibbonUI

为了解决这一问题，我将指向功能区的对象指针存储在三个地方，这对我来说似乎有点过头了，但显然仍然不够:

In attempt to combat this, I store the object pointer to the ribbon in THREE places, this seems like overkill to me but it is still apparently not sufficient:

• 名为cbRibbon的类对象具有分配的属性.RibbonUI；功能区的onLoad回调过程中的Set cbRibbon.RibbonUI = Rib.因此，我们拥有对象本身的byRef副本.如果功能区什么都没有，理论上我可以Set rib = cbRibbon.RibbonUI，除非cbRibbon对象也不在范围内，否则此方法可以正常工作.
• cbRibbon对象具有属性.Pointer，该属性分配为:cbRibbon.Pointer = ObjPtr(Rib).
• 称为"RibbonPointer"的CustomDocumentProperty也用于存储对对象指针的引用. (注意:即使状态丢失，这种情况仍然存在)

• A class object called cbRibbon has a property .RibbonUI which is assigned; Set cbRibbon.RibbonUI = Rib during the ribbon's onLoad callback procedure. So we have a byRef copy of the object itself. If the ribbon is nothing, theoretically I can Set rib = cbRibbon.RibbonUI and this works unless cbRibbon object is also out of scope.
• The cbRibbon object has property .Pointer which is assigned: cbRibbon.Pointer = ObjPtr(Rib).
• A CustomDocumentProperty called "RibbonPointer" is also used to store a reference to the object pointer. (Note: This persists even beyond state loss)

因此，您可以看到我对此进行了一些思考，试图以一种可能将其存储在Excel中的隐藏工作表/范围中的方式复制存储该指针的方式.

So you can see I've given some thought to this in attempt to replicate the way of storing this pointer the way one might store it in a hidden worksheet/range in Excel.

其他信息

从强大的客户端日志记录中我可以看到，该错误通常(但并非总是)在以下过程中发生，该过程用于刷新/使功能区及其控件无效.

I can see from robust client-side logging that this the error appears to happen usually but not always during the procedure below, which is used to refresh/invalidate the ribbon and its controls.

任何时候我需要动态刷新功能区或其部分控件时，都会调用此过程:

This procedure is called any time I need to dynamically refresh the ribbon or part of its controls:

Call RefreshRibbon(id)

该错误似乎是(有时，我对此不太强调:错误 不能按需复制)发生在完全刷新期间，这称为:

The error appears to (sometimes, I can't stress this enough: the error cannot be replicated on-demand) happen during a full refresh, which is called like:

Call RefreshRibbon("")

这是执行无效操作的过程:

This is the procedure that does the invalidation:

Sub RefreshRibbon(id As String)

    If Rib Is Nothing Then
        If RibbonError(id) Then GoTo ErrorExit
    End If

    Select Case id
        Case vbNullString, "", "RibbonUI"
            Call Logger.LogEvent("RefreshRibbon: Rib.Invalidate", Array("RibbonUI", _
                                            "Ribbon:" & CStr(Not Rib Is Nothing), _
                                            "Pointer:" & ObjPtr(Rib)))
            Rib.Invalidate

        Case Else
            Call Logger.LogEvent("RefreshRibbon: Rib.InvalidateControl", Array(id, _
                                            "Ribbon:" & CStr(Not Rib Is Nothing), _
                                            "Pointer:" & ObjPtr(Rib)))
            Rib.InvalidateControl id
    End Select

    Exit Sub

ErrorExit:

End Sub

如您所见，

我在此过程中所做的第一件事是测试Rib对象的Nothing -ness.如果计算结果为True，则RibbonUI对象以某种方式丢失.

As you can see, the very first thing I do in this procedure is test the Rib object for Nothing-ness. If this evaluates to True, then the RibbonUI object has somehow been lost.

然后，错误函数尝试重新实例化功能区:首先从cbRibbon.RibbonUI，然后从cbRibbon.Pointer，然后从CustomDocumentProperties("RibbonPointer")，然后从CustomDocumentProperties("RibbonPointer")值，再次初始化 .如果这些都不成功，则我们将显示致命错误，并提示用户关闭PowerPoint应用程序.如果其中任何一个成功，则将以编程方式重新加载功能区，并且一切都会继续进行.

The error function then attempts to re-instantiate the ribbon: first from cbRibbon.RibbonUI, then from the cbRibbon.Pointer and if both of those fails, then from the CustomDocumentProperties("RibbonPointer") value. If neither of these succeeds, then we display a fatal error and the user is prompted to close the PowerPoint application. If any one of these succeeds, then the ribbon is reloaded programmatically and everything continues to work.

这是该过程的代码.请注意，它调用了其他一些我没有包含代码的过程.这些是助手功能或记录器功能. .GetPointer方法实际上是调用WinAPI CopyMemory函数从其指针值重新加载对象.

Here is the code for that procedure. Note that it calls several other procedures which I have not included code for. These are helper functions or logger functions. The .GetPointer method actually invokes the WinAPI CopyMemory function to reload the object from its pointer value.

Function RibbonError(id As String) As Boolean
'Checks for state loss of the ribbon
Dim ret As Boolean

If id = vbNullString Then id = "RibbonUI"

Call Logger.LogEvent("RibbonError", Array("Checking for Error with Ribbon" & vbCrLf & _
                                            "id: " & id, _
                                            "Pointer: " & ObjPtr(Rib), _
                                            "cbPointer: " & cbRibbon.Pointer))

If Not Rib Is Nothing Then
    GoTo EarlyExit
End If

On Error Resume Next

    'Attempt to restore from class object:
    Set Rib = cbRibbon.ribbonUI

    'Attempt to restore from Pointer reference if that fails:
    If Rib Is Nothing Then
        'Call Logger.LogEvent("Attempt to Restore from cbRibbon", Array(cbRibbon.Pointer))
        If Not CLng(cbRibbon.Pointer) = 0 Then
            Set Rib = cbRibbon.GetRibbon(cbRibbon.Pointer)
        End If
    End If

    'Attempt to restore from CDP

    If Rib Is Nothing Then
        'Call Logger.LogEvent("Attempt to Restore from CDP", Array(MyDoc.CustomDocumentProperties("RibbonPointer")))
        If HasCustomProperty("RibbonPointer") Then
            cbRibbon.Pointer = CLng(MyDoc.CustomDocumentProperties("RibbonPointer"))
            Set Rib = cbRibbon.GetRibbon(cbRibbon.Pointer)

        End If
    End If

On Error GoTo 0

If Rib Is Nothing Then
    Debug.Print "Pointer value was: " & cbRibbon.Pointer
    'Since we can't restore from an invalid pointer, erase this in the CDP
    ' a value of "0" will set Rib = Nothing, anything else will crash the appliation
    Call SetCustomProperty("RibbonPointer", "0")
Else
    'Reload the restored ribbon:
    Call RibbonOnLoad(Rib)

    Call SetCustomProperty("RibbonPointer", ObjPtr(Rib))

    cbRibbon.Pointer = ObjPtr(Rib)
End If

'Make sure the ribbon exists or was able to be restored
ret = (Rib Is Nothing)

If ret Then
    'Inform the user
    MsgBox "A fatal error has been encountered. Please save & restart the presentation", vbCritical, Application.Name
    'Log the event to file
    Call Logger.LogEvent("RibbonError", Array("FATAL ERROR"))

    Call ReleaseTrap

End If

EarlyExit:

    RibbonError = ret

End Function

所有这些在理论上都可以很好地完成，实际上，我可以提高 kill 的运行时间(通过调用End语句或其他方式)，并且这些过程可以按预期方式重置功能区.

All of this works perfectly well in theory and in fact I can straight-up kill run-time (by invoking the End statement or otherwise) and these procedures reset the ribbon as expected.

那么，我想念什么?

推荐答案

好吧，我忘记了这一点……虽然我仍然没有查明错误，但我有一些想法，即用户根本不会报告未处理的运行时错误，而是在PowerPoint提示时重新点击结束".

OK I forgot about this... while I still have not pinpointed the error I have some ideas that users are simply not reporting unhandled runtime errors and instead they're hitting "End" when prompted by PowerPoint.

我有理由确定这是原因，并且我已经确认在很多情况下，这种错误是在崩溃"之前发生的，因此，我将进行更新以尽快解决该问题.

I'm reasonably certain that is the cause and I have confirmation that in many cases, that sort of error precedes the "crash", so I'm updating to resolve that soon.

否则，这是我最终使用了几个月的方法，并获得了成功.

Otherwise, here is the method I ultimately have been using for several months, with success.

创建一个将功能区的Pointer值写入用户机器上的过程.我不想这样做，但最终不得不:

Create a procedure that writes the Pointer value of the ribbon on the user's machine. I didn't want to do this, but ultimately had to:

Sub LogRibbon(pointer As Long)
    'Writes the ribbon pointer to a text file
    Dim filename As String
    Dim FF As Integer

    filename = "C:\users\" & Environ("username") & "\AppData\Roaming\Microsoft\AddIns\pointer.txt"

    FF = FreeFile
    Open filename For Output As FF
    Print #FF, pointer
    Close FF

End Sub

在功能区的_OnLoad事件处理程序中，我调用LogRibbon过程:

In the ribbon's _OnLoad event handler, I call the LogRibbon procedure:

Public Rib As IRibbonUI
Public cbRibbon As New cRibbonProperties
Sub RibbonOnLoad(ribbon As IRibbonUI)
'Callback for customUI.onLoad


    Set Rib = ribbon

    Call LogRibbon(ObjPtr(Rib))

    'Store the properties so we can easily access them later
    cbRibbon.ribbonUI = Rib


End Sub

我创建了一个类对象来存储有关功能区的一些信息，以避免重复和缓慢地调用外部API，但是为此，您可以创建一个仅存储指针值的类.上面在cbRibbon.ribbonUI = Rib中引用了该内容.此类的GetRibbon方法使用WinAPI中的CopyMemory函数从其指针还原对象.

I created a class object to store some information about the ribbon to avoid repeated and slow calls to an external API, but for this purpose you can create a class that stores just the pointer value. That is referenced above in the cbRibbon.ribbonUI = Rib. This GetRibbon method of this class uses the CopyMemory function from WinAPI to restore the object from it's pointer.

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (destination As Any, source As Any, _
    ByVal length As Long)


'example ported from Excel:
'http://www.excelguru.ca/blog/2006/11/29/modifying-the-ribbon-part-6/
Private pControls As Object
Private pRibbonUI As IRibbonUI
Private pPointer As Long

Sub Class_Initialize()
    'Elsewhere I add some controls to this dictionary so taht I can invoke their event procedures programmatically:
    Set pControls = CreateObject("Scripting.Dictionary")

    Set pRibbonUI = Rib

    Call SaveRibbonPointer(Rib)

    pConnected = False
End Sub


'#############################################################
'hold a reference to the ribbon itself
    Public Property Let ribbonUI(iRib As IRibbonUI)
        'Set RibbonUI to property for later use
        Set pRibbonUI = iRib

    End Property

    Public Property Get ribbonUI() As IRibbonUI
        'Retrieve RibbonUI from property for use
        Set ribbonUI = pRibbonUI
    End Property

'http://www.mrexcel.com/forum/excel-questions/518629-how-preserve-regain-id-my-custom-ribbon-ui.html
Public Sub SaveRibbonPointer(ribbon As IRibbonUI)
    Dim lngRibPtr As Long
    ' Store the custom ribbon UI Id in a static variable.
    ' This is done once during load of UI.

    lngRibPtr = ObjPtr(ribbon)

    cbRibbon.pointer = lngRibPtr

End Sub
Function GetRibbon(lngRibPtr As Long) As Object
    'Uses CopyMemory function to re-load a ribbon that
    ' has been inadvertently lost due to run-time error/etc.
    Dim filename As String
    Dim ret As Long
    Dim objRibbon As Object

    filename = "C:\users\" & Environ("username") & "\AppData\Roaming\Microsoft\AddIns\pointer.txt"

    On Error Resume Next
    With CreateObject("Scripting.FileSystemObject").GetFile(filename)
        ret = .OpenAsTextStream.ReadLine
    End With
    On Error GoTo 0

    If lngRibPtr = 0 Then
        lngRibPtr = ret
    End If

    CopyMemory objRibbon, lngRibPtr, 4
    Set GetRibbon = objRibbon
    ' clean up invalid object
    CopyMemory objRibbon, 0&, 4
    Set objRibbon = Nothing

End Function


'##############################################################
' Store the pointer reference to the RibbonUI
    Public Property Let pointer(p As Long)
        pPointer = p
    End Property
    Public Property Get pointer() As Long
        pointer = pPointer
    End Property

'#############################################################
'Dictionary of control properties for Dropdowns/ComboBox
    Public Property Let properties(p As Object)
        Set pProperties = p
    End Property
    Public Property Get properties() As Object
        Set properties = pProperties
    End Property

然后，我有一个检查色带丢失的函数，并从指针值中恢复.这实际上调用了OnLoad过程，因为我们有一个表示Ribbon对象的对象变量(或类object属性)，所以我们可以这样做.

Then, I have a function which checks for loss of ribbon, and restores from the pointer value. This one actually invokes the OnLoad procedure, which we can do since we have an object variable (or class object property) representing the Ribbon object).

Function RibbonError(id As String) As Boolean
'Checks for state loss of the ribbon
Dim ret As Boolean
Dim ptr As Long
Dim src As String

On Error Resume Next

If Not Rib Is Nothing Then
    GoTo EarlyExit
End If

If Rib is Nothing then
    ptr = GetPointerFile
    cbRibbon.pointer = ptr
    Set Rib = cbRibbon.GetRibbon(ptr)
End If
On Error GoTo 0

'make sure the ribbon has been restored or exists:
ret = (Rib is Nothing)

If Not ret then
    'Reload the restored ribbon by invoking the OnLoad procedure
    ' we can only do this because we have a handle on the Ribbon object now
    Call RibbonOnLoad(Rib)
    cbRibbon.pointer = ObjPtr(Rib) 'store the new pointer
Else
    MsgBox "A fatal error has been encountered.", vbCritical
End If

EarlyExit:
RibbonError = ret
End Function

只要要通过Invalidate或InvalidateControl方法刷新功能区，就可以调用RibbonError函数.

Call on the RibbonError function any time you are going to refresh the ribbon through either Invalidate or InvalidateControl methods.

上面的代码可能无法100％编译-我不得不对其进行修改并删掉一些东西，所以如果您在尝试实现它时遇到任何问题，请告诉我！

The code above may not 100% compile -- I had to modify it and trim some stuff out, so let me know if you have any problems trying to implement it!

这篇关于RibbonUI的PowerPoint加载项丢失的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！