Question

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

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

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

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

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

我目前如何处理损失或RibbonUI

为了解决这个问题，我将对象指针存储在 THREE 位置的功能区中，这对我来说似乎有些过分但显然仍然不够：

名为cbRibbon的类对象具有已分配的属性.RibbonUI;功能区Set cbRibbon.RibbonUI = Rib回调过程中的onLoad。所以我们有一个byRef对象本身的副本。如果功能区什么都没有，理论上我可以Set rib = cbRibbon.RibbonUI，除非cbRibbon对象也超出范围，否则这样可行。
cbRibbon对象的属性.Pointer已分配：cbRibbon.Pointer = ObjPtr(Rib)。
CustomDocumentProperty名为＆＃34; RibbonPointer＆＃34;还用于存储对象指针的引用。（注意：这甚至超出状态损失）

因此，您可以看到我已经考虑过这一点，试图复制存储此指针的方式，就像将它存储在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的{{1}}对象。如果此计算结果为Nothing，那么RibbonUI对象就会以某种方式丢失。

错误函数然后尝试重新实例化功能区：首先来自True，然后来自cbRibbon.RibbonUI，如果两者都失败，则来自{{ 1}}价值。如果这些都不成功，那么我们会显示致命错误，并提示用户关闭PowerPoint应用程序。如果其中任何一个成功，则以编程方式重新加载功能区，一切都继续工作。

以下是该程序的代码。请注意，它调用了其他几个我没有包含代码的过程。这些是辅助函数或记录器函数。 cbRibbon.Pointer方法实际调用WinAPI CustomDocumentProperties("RibbonPointer")函数从指针值重新加载对象。

.GetPointer

所有这些在理论上都非常有效，事实上我可以直接 kill 运行时（通过调用CopyMemory语句或其他方式）并且这些过程将功能区重置为预期

enter image description here

那么，我错过了什么？

Answer 1

好的，我忘记了这一点......虽然我还没有找到错误，但我有一些想法，用户根本没有报告未处理的运行时错误，而是他们正在打击＆＃34;结束＆＃34;当PowerPoint提示时。

我合理地确定这是原因，我确认在许多情况下，这种错误发生在＆＃34;崩溃＆＃34;之前，所以我要更新以尽快解决。

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

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

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

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

上面的代码可能不是100％编译 - 我必须修改它并修剪一些东西，所以如果你在尝试实现它时有任何问题，请告诉我！

Answer 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

RibbonU的PowerPoint加载项丢失

2 个答案: