Как смоделировать ThisPresentation в PowerPoint VBA

Question

Я хотел бы иметь доступ к свойствам документа файла надстройки PowerPoint (презентация, сохраненная как «Надстройка PowerPoint (*.ppa)» из некоторого кода VBA в самой надстройке.

Если это помогает понять проблему, на самом деле я пытаюсь прочитать пользовательское свойство документа, в котором хранится номер версии надстройки, чтобы я мог отобразить его в диалоговом окне.

С Word и Excel я могу сделать это, используя ThisDocument & ThisWorkbook, оба из которых возвращают ссылку на документ, содержащий работающий код.Однако нет ThisPresentation эквивалент в PowerPoint.

Для стандартной презентации или шаблона PowerPoint я мог бы использовать ActivePresentation.Однако этот метод не будет работать для надстройки.

Есть идеи?Пожалуйста, никаких предложений о том, куда еще мне следует вставить номер версии :-)

Answer 1

ИЗМЕНЕНО 2 ФЕВРАЛЯ 2010 ГОДА:Очищенный ответ, чтобы показать только окончательное решение

---

Вот способ сделать то, что просили, без DLL.Действительно просто:

Sub ReturnPPAasPresentation()
    Dim p As Presentation
    Set p = Presentations("presentation1.ppa")
    Dim title As String, version As String
    version = p.CustomDocumentProperties("Version").Value
    title = p.BuiltInDocumentProperties("Title").Value
    MsgBox "Version: " & version & " of " & title, vbOKOnly, title
End Sub

Answer 2

Как и все остальные, я ожидал появления объекта ThisPresentation в PowerPoint.Я подумал о другом способе сделать это без жестко запрограммированного имени файла.Очевидно, что любой фрагмент кода должен уметь различать проекты.Я решил использовать для этого имя проекта (имя по умолчанию «VBAProject» в обозревателе проектов):он не используется ни для чего другого, ни один пользователь не сможет его изменить, а если он защищен, он не сможет этого сделать.

Вот мой код (измените MyProject на свое собственное имя проекта):

Function ThisPresentation() As Presentation
Dim p As Presentation

For Each p In Presentations
    If p.VBProject.Name = "MyProject" Then
        Set ThisPresentation = p
        Exit Function
    End If
Next
End Function

Answer 3

Благодарим macnerd nerd за общую идею, но добавили функциональность AddIn.К сожалению, надстройки не имеют имен VBProject, поэтому они не так надежны:

Function ThisPresentation(project_name As String) As Object
Dim p As Object

all_presentations = Array(Application.AddIns, Application.Presentations)
For Each pArray In all_presentations
    For Each p In pArray
        Debug.Print p.FullName
        If InStr(p.FullName, project_name) > 0 Then
            Set ThisPresentation = p
            Exit Function
        End If
    Next
Next
End Function