Пользовательские значки не отображаются при попытке создания ленты Excel - PullRequest
Новая
       25

Пользовательские значки не отображаются при попытке создания ленты Excel

0 голосов
/ 24 марта 2020

Я пытаюсь создать надстройку, которая автоматически создает ленту с пользовательскими макросами и значками при установке / открытии.

До сих пор я смог получить ленту для сборки при выборе / открытии AddIn, макросы, назначенные кнопкам на нем, работают нормально, моя проблема заключается в пользовательских значках, которые я пытаюсь использовать для каждого кнопка макроса, не отображаются. Я подозреваю, что это проблема пути при создании ленты, но мои знания VBA недостаточно обширны, чтобы можно было проверить и исправить эту проблему.

Я использую функцию обратного вызова, присутствующую в xml и в модуле vba, для загрузки изображений при построении ленты. Изображения представляют собой файлы .png, которые, как я понимаю, могут возникнуть проблемы с загрузкой в ​​Excel при использовании функции LoadPicture, но я пробовал использовать файлы .jpg, но она все равно не работала.

Это код xml, используемый 

    <?xml version="1.0" encoding="UTF-8"?>
<customUI onLoad="Ribbon_Load" xmlns="http://schemas.microsoft.com/office/2006/01/customui" loadImage="CallbackLoadImage">
    <ribbon>
        <tabs>
            <tab id="AutoReport" label="AutoReport" insertAfterMso="Developer">
                <group id="group1" label="General">
                    <button id="button1" onAction = "New_Slide_Button" description="Create a new slide in the presentation" label="New Slide" size="large" image= "New_Slide.png"/>
                    <button id="button2" onAction = "Apply_Theme_Button" description="Apply theme to presentation" label="Apply Theme" size="large" image="Apply_Theme.png" />
                    <button id="button3" onAction = "Apply_Theme_Button.png" description="Apply formatting to presentation" label="Apply Formatting" size="large" image="Apply_Formatting.png" />
                </group>
                <group id="group2" label="Styling">
                    <dropDown id="dropDown1" label="Theme" image="Theme.png" />
                    <dropDown id="dropDown2" label="Font" image="Font.png" />
                </group>
                <group id="group3" label="View">
                    <button id="button4" onAction = "New_Preview_Button" description="Create new preview of presentation" label="New Preview" image="Clean_Preview.png" />
                    <button id="button5" onAction = "Save_Preview_Button" description="Save preview formatting and layout of presentation" label="Save Preview" image="Save.png" />
                    <button id="button6" onAction = "Preview_Button" label="Preview" image="Preview.png"/>
                </group>
                <group id="group4" label="Command">
                    <button id="button7" onAction ="Build_Presentation_Button" description="Create PowerPoint Presentation" label="Create Presentation" size="large" image="Create_Presentation.png" />
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

Код VBA, используемый для построения ленты, выглядит следующим образом: 

Sub Build_Ribbon()

Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String
Dim my_file As Integer
Dim text_line As String
Dim file_name As String
Dim i As Integer

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"

    ribbonXML = ""
    file_name = "C:\Users\" & user & "\AppData\Roaming\Microsoft\AddIns\Smart Report\AutoReportXML.txt"
    my_file = FreeFile()
    Open file_name For Input As my_file

    i = 1

    While Not EOF(my_file)
        Line Input #my_file, text_line
        ribbonXML = ribbonXML & text_line & vbNewLine
        i = i + 1
    Wend

Debug.Print ribbonXML

Close hFile
Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

'ribbonXML = "<mso:customUI           xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<mso:ribbon></mso:ribbon></mso:customUI>"

End Sub

Обратный вызов, используемый для загрузки Изображения выглядят следующим образом: 

Sub CallbackLoadImage(imageID As String, ByRef image)
Dim ThisPath As String
ThisPath = Application.ActiveWorkbook.path

 Set image = LoadPicture(ThisPath & "\Icons\" & imageID)
End Sub

Все изображения находятся в папке «Значки» в одном каталоге. Не уверен, где я иду не так.

Любая помощь будет принята с благодарностью.

...