Как настроить ленту из кода в Excel 365?

Question

Я знаком с процедурами VBA, необходимыми для настройки ленты Excel в Excel 2013 и ниже.

При попытке открыть файл в Excel 365 я получаю сообщение об ошибке:

Вот код, который я использую (который работает в Excel 2010):

Sub CreateMenu()
    ' Delete the CommandBar if it exists already
    On Error Resume Next
    Application.CommandBars("Worksheet Menu Bar").Controls("My Tool").Delete

    Set cControl = Application.CommandBars("Worksheet Menu Bar").Controls.Add
    With cControl
        .Caption = "My Tool"
        .Style = msoButtonCaption
    End With


End Sub

Как изменить код для работы в версиях Excel 2010 и Excel 365?

Answer 1

Ваш вопрос на самом деле два вопроса ИМО.

• Как заставить работать код для каждой версии (различие между версиями Office)
• Как заставить код работать для Office 365

Я провел небольшое исследование по настройке ленты Office 365 и обнаружил несколько вещей, которые, я надеюсь, могут помочь.

После Office365 / 2019 стало намного сложнее проводить различия между версиями Office. Раньше вы могли просто использовать Select Case Int(Application.Version) в сочетании с Case 11/14 и т. Д. Но теперь все 2016 и выше просто возвращает Case 16.

Я обнаружил функцию, позволяющую различать версии Office , а также некоторую информацию о том, что CommandBars("Worksheet Menu Bar").Controls.Add был "заменен новым ленточным компонентом пользовательского интерфейса Microsoft Office Fluent."

У меня нет 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