如何从Excel 365中的代码自定义功能区?

时间:2019-06-03 07:58:19

标签: excel vba

我熟悉自定义Excel 2013及以下版本的Excel功能区所需的VBA例程。

尝试在Excel 365上打开文件时,出现错误消息:

enter image description here

这是我使用的代码(适用于Excel 2010):

<script src="https://cdnjs.cloudflare.com/ajax/libs/react/16.6.3/umd/react.production.min.js"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/react-dom/16.6.3/umd/react-dom.production.min.js"></script>
<div id="root"></div>

如何修改代码以在Excel 2010和Excel 365版本上运行?

1 个答案:

答案 0 :(得分:0)

您的问题实际上是IMO的两个问题。

  • 如何使每个版本的代码都能工作(在Office版本之间有所区别)
  • 如何使代码适用于Office 365

我对Office 365功能区自定义进行了一些研究,发现了一些希望对您有所帮助的东西。

自Office365 / 2019起,区分Office版本变得越来越困难。 You used to be able to just use Select Case Int(Application.Version)加上Case 11/14等。但是现在2016年及以后的所有内容都只返回Case 16

我找到了a function to differentiate between Office Versions和一些信息,CommandBars("Worksheet Menu Bar").Controls.Add已经是"superseded by the new ribbon component of the Microsoft Office Fluent user interface."

我没有Office 365来测试如何修改代码,但是一旦使该部分正常工作,就可以实现该解决方案:

Private Sub Workbook_Open()

    If CStr(AppVersion) = 365 Then
    MsgBox "Office 365" 'Setup new code here for Office365
    ' See --> https://docs.microsoft.com/en-us/office/vba/api/office.commandbarcontrols.add
    ' Note: The use of CommandBars in some Microsoft Office applications has been superseded by the new ribbon component of the Microsoft Office Fluent user interface.
    ' For more information, see Overview of the Office Fluent ribbon.
    ' https://docs.microsoft.com/en-us/office/vba/library-reference/concepts/overview-of-the-office-fluent-ribbon
    Else
    MsgBox "Non-Office 365" ' Insert known working code here for older versions of Office/Excel or call seperate sub for Non-Office 365
    End If

End Sub

Private Function AppVersion() As Long
    'Test the Office application version
    'Written by Ken Puls (www.excelguru.ca)
    'https://www.excelguru.ca/blog/2019/02/11/check-the-application-version-in-modern-office/

    Dim registryObject As Object
    Dim rootDirectory As String
    Dim keyPath As String
    Dim arrEntryNames As Variant
    Dim arrValueTypes As Variant
    Dim x As Long

    Select Case Val(Application.Version)

        Case Is = 16
        'Check for existence of Licensing key
        keyPath = "Software\Microsoft\Office\" & CStr(Application.Version) & "\Common\Licensing\LicensingNext"
        rootDirectory = "."
        Set registryObject = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & rootDirectory & "\root\default:StdRegProv")
        registryObject.EnumValues &H80000001, keyPath, arrEntryNames, arrValueTypes

        On Error GoTo ErrorExit
        For x = 0 To UBound(arrEntryNames)
            If InStr(arrEntryNames(x), "365") > 0 Then
                AppVersion = 365
                Exit Function
            End If
            If InStr(arrEntryNames(x), "2019") > 0 Then
                AppVersion = 2019
                Exit Function
            End If
        Next x

        Case Is = 15
            AppVersion = 2013
        Case Is = 14
            AppVersion = 2010
        Case Is = 12
            AppVersion = 2007
        Case Else
            'Too old to bother with
            AppVersion = 0
    End Select

  Exit Function

ErrorExit:
    'Version 16, but no licensing key.  Must be Office 2016
    AppVersion = 2016

End Function