时间戳

首页 > 解决方案 > Options.DefaultHighlightColorIndex 更改后刷新内置功能区按钮并避免退出“文本突出显示颜色”

vba - Options.DefaultHighlightColorIndex 更改后刷新内置功能区按钮并避免退出“文本突出显示颜色”

问题描述

我正在努力工作：

我被困在哪里：

Sub cycleThroughSomeDefaultHighlightColorIndexOptions()
Dim zeNewColor As Long

Select Case Options.DefaultHighlightColorIndex
       Case wdYellow:      zeNewColor = wdBrightGreen
       Case wdBrightGreen: zeNewColor = wdTurquoise
       Case wdTurquoise:   zeNewColor = wdPink
       Case wdBlue:        zeNewColor = wdRed
       Case wdRed:         zeNewColor = wdYellow
       Case Else:          zeNewColor = wdYellow
End Select
Application.Options.DefaultHighlightColorIndex = zeNewColor

End Sub

不会抛出任何错误，会更改 Application.Options.DefaultHighlightColorIndex，

但不会在相应的（内置功能区主页选项卡）按钮上更新/显示新设置的颜色

并退出文本突出显示颜色模式。

  1. 有没有可能继续下去？

  2. 如果需要重新启动：有没有比脏/干扰sendKeys更好的方法来调用诸如Text Highlight Color之类的命令？

2019-04-03 更新： 与此同时，我发现了IRibbonUI.InvalidateControlMso ControlIDs 的列出位置：Office 2016 帮助文件：Office Fluent 用户界面控制标识符

因此，在创建隐藏的自定义功能区并在 onLoad 上获取它的句柄后，我可以zeWdRibbon.InvalidateControlMso "TextHighlightColorPicker"没有任何引发的错误。

但它也没有改变任何东西。

有没有可能，微软只是在不检查 Application.Options.DefaultHighlightColorIndex 的情况下获取默认的 imageMso“TextHighlightColorPicker”（黄色），或者我错过了什么？

标签： vbams-word

解决方案

我每次都做这样的事gRibbon.Invalidate

#If VBA7 Then
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
#Else
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
#End If

Public gRibbon As IRibbonUI

#If VBA7 Then
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
#Else
Function GetRibbon(ByVal lRibbonPointer As Long) As Object
#End If

    Dim objRibbon As Object
    Call CopyMemory(objRibbon, lRibbonPointer, LenB(lRibbonPointer))
    Set GetRibbon = objRibbon
    Set objRibbon = Nothing
End Function

Public Sub OnRibbonLoad(ribbon As IRibbonUI)
    Set gRibbon = ribbon
    'SAVE SETTINGS TO REGISTRY
    SaveSetting "POP", "RIBBON", "ribbonPointer", ObjPtr(gRibbon)
End Sub

Public Sub OnActionButton(control As IRibbonControl)
        If gRibbon Is Nothing Then
            Set gRibbon = GetRibbon(GetSetting("POP", "RIBBON", "ribbonPointer"))
        End If
    On Error Resume Next
        gRibbon.Invalidate
    On Error GoTo 0
End Sub

推荐阅读