PowerPoint 加载项丢失 RibbonUI答案

【问题标题】：PowerPoint Add-In Loss of RibbonUIPowerPoint 加载项丢失 RibbonUI
【发布时间】：2014-11-26 16:47:33
【问题描述】：

我一直在努力找出分布在大约 40 个最终用户中的 PPT 插件中的错误原因。

问题：功能区状态丢失/功能区UI对象丢失。

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

用户向我保证，他们没有收到任何运行时错误或脚本错误（来自我们也通过此插件调用的 COM 对象）。如果用户点击End，则会出现未处理的错误，预计会导致状态丢失。

没有一个用户能够可靠地重现导致观察到的故障的场景。这使得故障排除非常困难。我希望有一些明显的东西是我遗漏的，或者是我没有预料到的。

我目前如何处理丢失或 RibbonUI

为了解决这个问题，我将指向功能区的对象指针存储在三个位置，这对我来说似乎有点矫枉过正，但显然还不够：

一个名为cbRibbon 的类对象有一个属性.RibbonUI 被赋值； Set cbRibbon.RibbonUI = Rib 在功能区的 onLoad 回调过程中。所以我们有一个对象本身的byRef 副本。如果功能区什么都不是，理论上我可以Set rib = cbRibbon.RibbonUI 并且这有效，除非cbRibbon 对象也超出范围。
cbRibbon 对象的属性 .Pointer 被分配：cbRibbon.Pointer = ObjPtr(Rib)。
名为“RibbonPointer”的CustomDocumentProperty 也用于存储对对象指针的引用。（注意：这种情况即使在状态丢失之后仍然存在）

所以你可以看到我已经对此进行了一些思考，试图复制存储此指针的方式，就像将它存储在 Excel 中的隐藏工作表/范围中一样。

其他信息

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

只要我需要动态刷新功能区或其部分控件，就会调用此过程：

Call RefreshRibbon(id)

错误似乎（有时，我不能强调这一点：错误不能按需复制）发生在完全刷新期间，称为：

Call RefreshRibbon("")

这是进行失效的程序：

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 对象已经丢失。

然后错误函数尝试重新实例化功能区：首先从cbRibbon.RibbonUI，然后从cbRibbon.Pointer，如果这两个都失败，然后从CustomDocumentProperties("RibbonPointer") 值。如果这些都没有成功，那么我们会显示一个致命错误，并提示用户关闭 PowerPoint 应用程序。如果其中任何一项成功，则功能区将以编程方式重新加载，一切都会继续工作。

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

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 语句或其他方式）并且这些过程按预期重置功能区。

那么，我错过了什么？

【问题讨论】：

查看我自己在 Access 2010 中处理功能区的方式，我发现我正在使用 CopyMemory API 调用来设置功能区对象。像这样的东西：Private Function GetRibbon(lngRibPtr As Long) As Object: Dim objRibbon As Object: CopyMemory objRibbon, lngRibPtr, 4: Set GetRibbon = objRibbon: Set objRibbon = Nothing: End Function也许对你有帮助？
@Bobort 是的，我实际上在内部使用那个 WinAPI 调用（在这个调用的GetRibbon 方法中：Set Rib = cbRibbon.GetRibbon(cbRibbon.Pointer)）。这里的问题不是“如何从指针恢复功能区”，而是 A）导致功能区状态丢失的原因和 B）我可以在 PowerPoint 中可靠地保存指针值的位置（最好这不涉及写入磁盘或更改注册表，虽然我可以两者都做，但如果可能的话，我宁愿不做）。

标签： vba powerpoint ribbonx

【解决方案1】：

好的，我忘记了这一点……虽然我还没有查明错误，但我有一些想法，即用户根本没有报告未处理的运行时错误，而是在 PowerPoint 提示时点击“结束”。

我有理由确定这是原因，并且我确认在许多情况下，这种错误会在“崩溃”之前发生，因此我会尽快更新以解决该问题。

否则，这是我最终使用了几个月的方法，成功了。

创建一个将功能区的指针值写入用户计算机的过程。我不想这样做，但最终不得不：

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 过程：

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 函数从其指针中恢复对象。

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 对象的对象变量（或类对象属性）。

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 函数。

上面的代码可能无法 100% 编译——我不得不修改它并删除一些东西，所以如果你在尝试实现它时遇到任何问题，请告诉我！

【讨论】：

【解决方案2】：

找到真正的解决方案：Credit

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

Public Sub ribbon L o a ded(ribbon As IRibbonUI)
   ' Store pointer to IRibbonUI
   Dim lngRibPtr As Long
' Store the custom ribbon UI Id in a static variable.
' This is done once during load of UI. I.e. during workbook open.
    Set guiRibbon = ribbon
    lngRibPtr = ObjPtr(ribbon)
    ' Write pointer to worksheet for safe keeping
    Tabelle2.Range("A1").Value = lngRibPtr
End Sub
Function GetRibbon(lngRibPtr as Long) As Object
   Dim objRibbon As Object
   CopyMemory objRibbon, lngRibPtr, 4
   Set GetRibbon = objRibbon
   ' clean up invalid object
   CopyMemory objRibbon, 0&, 4
   Set objRibbon = Nothing
End Function

然后

    Public Sub DoButton(ByVal control As IRibbonControl)
' The onAction callback for btn1 and btn2

    ' Toggle state
    Toggle12 = Not Toggle12

    ' Invalidate the ribbon UI so that the enabled-states get reloaded
    If Not (guiRibbon Is Nothing) Then
        ' Invalidate will force the UI to reload and thereby ask for their enabled-states
        guiRibbon.Invalidate 'Control ("tabCustom") InvalidateControl does not work reliably
    Else
      Set guiRibbon = GetRibbon(CLng(Tabelle2.Range("A1").Value))
      guiRibbon.Invalidate
        ' The static guiRibbon-variable was meanwhile lost
'        MsgBox "Due to a design flaw in the architecture of the MS ribbon UI you have to close " & _
'            "and reopen this workbook." & vbNewLine & vbNewLine & _
'            "Very sorry about that.", vbExclamation + vbOKOnly
      MsgBox "Hopefully this is sorted now?"
        ' Note: In the help we can find
        ' guiRibbon.Refresh
        ' but unfortunately this is not implemented.
        ' It is exactly what we should have instead of that brute force reload mechanism.
    End If

End Sub

【讨论】：

On Error Resume Next: Debug.Print 1/0 不会重置 VBA 中的公共变量，因为这实际上是一个已处理的异常:) 最终我最终做了什么（我不喜欢，但用户体验令人满意）是在用户机器上创建一个文本文件并将功能区的指针值存储在该文件中。当我测试Nothing 时，我可以使用CopyMemory API 调用从指针值中恢复。不幸的是，我在寻找错误的根本原因方面没有取得任何进展，但至少我掌握了它。
嗨，是的，多读一点 Excel 将在“丢失状态”时清除全局变量，其中包括删除工作表、插入活动 x 控件、未处理的异常等。你能分享一下你是如何管理的保存状态，以及如何再次设置全局变量。谢谢
实际上刚刚找到了一个很好的解释如何做到这一点here是其他人的链接
我稍后会尝试回到这个问题并回答我是如何“解决”它的——我现在正在使用移动设备
我在下面添加了我的解决方案。