При работе с Ribbon бывает нужным переменная, содержащая интерфейс ленты (IRibbonUI).
В XML-файле мы указываем callback-процедура, которая вызывается при загрузке ленты.
XML:
Callback:
Всё бы ничего, но когда возникает ошибка, переменная ribbon становится Nothing.
В прилагаемом мною файле я создал новую вкладку "Ribbon Pointer Test". В ней две кнопки:
1. Сгенерировать ошибку - генерирует ошибку делением единицы на ноль.
2. Invalidate Ribbon - обновляет ленту.
Код "Сгенерировать ошибку":
Код "Invalidate Ribbon":
После генерации ошибки нажатие на Invalidate Ribbon VBA выдаёт такое сообщение: "Object variable or With block variable not set". Другими словами, ribbon Is Nothing.
Решение данной проблемы может быть решено путём сохранения адреса ленты в памяти
Для этого:
1. Создаём именованный диапазон:
2. Объявляем Win32 API функцию RtlMove:
3. Сохраняем адрес ленты в именованный диапазон во время загрузки ленты:
4. Создаём процедуру для восстановления адреса:
Для проверки раскомментируйте строку 'RestoreRibbon в процедуре InvalidateRibbon.
В XML-файле мы указываем callback-процедура, которая вызывается при загрузке ленты.
XML:
| Код |
|---|
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" on Load="OnRibbonLoad"> <ribbon startFromScratch="false"> <tabs> <tab id="rxTab1" label="Ribbon Pointer Test"> <group id="rxGroup1" label="Error Generator"> <button id="rxButton1" on Action="GenerateError" imageMso="HappyFace" size="large" label="Сгенерировать ошибку" /> <button id="rxButton2" on Action="InvalidateRibbon" imageMso="HappyFace" size="large" label="Invalidate Ribbon" tag=":)" /> </group> </tab> </tabs> </ribbon> </customUI> |
Callback:
| Код |
|---|
Public ribbon As IRibbonUI Sub OnRibbonLoad(ByRef IRibbon As IRibbonUI) Set ribbon = IRibbon End Sub |
Всё бы ничего, но когда возникает ошибка, переменная ribbon становится Nothing.
В прилагаемом мною файле я создал новую вкладку "Ribbon Pointer Test". В ней две кнопки:
1. Сгенерировать ошибку - генерирует ошибку делением единицы на ноль.
2. Invalidate Ribbon - обновляет ленту.
Код "Сгенерировать ошибку":
| Код |
|---|
Private Sub GenerateError(ByRef ctrl As IRibbonControl) Dim r As Long r = 1 / 0 End Sub |
Код "Invalidate Ribbon":
| Код |
|---|
Private Sub InvalidateRibbon(ByRef ctrl As IRibbonControl) 'RestoreRibbon ribbon.Invalidate End Sub |
После генерации ошибки нажатие на Invalidate Ribbon VBA выдаёт такое сообщение: "Object variable or With block variable not set". Другими словами, ribbon Is Nothing.
Решение данной проблемы может быть решено путём сохранения адреса ленты в памяти
Для этого:
1. Создаём именованный диапазон:
| Код |
|---|
Sub AddNameForRibbonPointer() Names.Add Name:="RibbonPointer", RefersTo:="", Visible:=False End Sub |
2. Объявляем Win32 API функцию RtlMove:
| Код |
|---|
#If VBA7 Then Public Declare PtrSafe Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (ByRef destination As Any, ByRef Source As Any, ByVal length As LongPtr) #Else Public Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (ByRef destination As Any, ByRef Source As Any, ByVal length As Long) #End If |
3. Сохраняем адрес ленты в именованный диапазон во время загрузки ленты:
| Код |
|---|
Public ribbon As IRibbonUI
Sub OnRibbonLoad(ByRef IRibbon As IRibbonUI)
Set ribbon = IRibbon
Names("RibbonPointer"). Value = ObjPtr(ribbon)
End Sub
|
4. Создаём процедуру для восстановления адреса:
| Код |
|---|
Sub RestoreRibbon() If ribbon Is Nothing Then #If VBA7 Then Dim lPointer As LongPtr lPointer = CLngPtr([RibbonPointer]) #Else Dim lPointer As Long lPointer = CLng([RibbonPointer]) #End If CopyMemory ribbon, lPointer, LenB(lPointer) End If End Sub |
Для проверки раскомментируйте строку 'RestoreRibbon в процедуре InvalidateRibbon.
There is no knowledge that is not power
))). Стабильно - это от PC к PC, от версии MSO к версии MSO. 
.