Как добавить в PowerPoint 2010 шкалу прогресса слайдов. VBA

Article
05/05/2010

Озадачился проблемой: добавить в PowerPoint визуальную шкалу прогресса слайдов.

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

(И пока я ставлю себе VS2010…)

Сегодня мы посмотрим, как добавить такой Progress Bar средствами VBA.

Включаем Developer-панель

Для начала нужно включить Developer-панель, чтобы можно было редактировать макросы, создавать формочки и т.п.

Для этого достаточно щелкнуть правой кнопкой по ribbon-ленте PowerPoint и выбрать кастомизацию. Далее отметить галочкой вкладку Developer:

После этого в вашей ленте появится соответствующая вкладка:

Выбрав “Visual Basic” вы откроете окно для создания форм, модулей и пр.

Создаем форму для вставки Progress Bar

Создаем новую форму:

(давно я не работал с формочками :)

Вставка и удаление ProgressBar

Добавляем парочку соответстующих функций…

Вставка ProgressBar

Здесь мы, кстати, уже можем работать с секциями слайдов, которые появились в Office 2010.

 Sub AddProgressBars(ByVal SlidesColor As String, ByVal SectionsColor As String)

    Dim X As Long

    Dim LastSection As Long

    Dim CurrentSection As Long

    Dim Left As Double

    Dim Top As Double

    Dim Height As Double

    Dim progressBar As Shape

    LastSection = 0

    Left = 0

    Height = 6

    Top = ActivePresentation.PageSetup.SlideHeight - Height

    RemoveProgressBars

    With ActivePresentation

        For X = 2 To .Slides.Count

            Set progressBar = .Slides(X).Shapes.AddShape(msoShapeRectangle, _

                Left, Top, _

                ((X - 1) * .PageSetup.SlideWidth) / (.Slides.Count - 1), Height)

            With progressBar

                .Fill.ForeColor.RGB = SlidesColor

                .Line.Visible = msoFalse

                .Name = "SlidesProgressBar"

            End With

            CurrentSection = .Slides(X).sectionIndex

            If (CurrentSection > LastSection) Then

                Set sectionBar = .Slides(X).Shapes.AddShape(msoShapeRectangle, _

                ((X - 2) * .PageSetup.SlideWidth) / (.Slides.Count - 1), Top, _

                ((1) * .PageSetup.SlideWidth) / (.Slides.Count - 1), Height)

                With sectionBar

                    .Fill.ForeColor.RGB = SectionsColor

                    .Line.Visible = msoFalse

                    .Name = "SectionProgressBar"

                End With

                LastSection = CurrentSection

            End If

        Next X

    End With

End Sub

Удаление ProgressBar

 Sub RemoveProgressBars()

    Dim X As Long

    On Error Resume Next

    For X = 1 To ActivePresentation.Slides.Count

        ActivePresentation.Slides(X).Shapes("SlidesProgressBar").Delete

        ActivePresentation.Slides(X).Shapes("SectionProgressBar").Delete

    Next X

End Sub

События на форме и обработка цвета

Добавляем события на нажатия кнопок:

 Private Sub ClearButton_Click()

    RemoveProgressBars

End Sub

Private Sub InsertButton_Click()

    Dim SlidesColor As String

    Dim SectionsColor As String

    SlidesColor = HEX2RGB(SlidesColorTextBox.Text)

    SectionsColor = HEX2RGB(SectionsColorTextBox.Text)

    AddProgressBars SlidesColor, SectionsColor

End Sub

Здесь используется функция HEX2RGB для преобразования описания цвета в виде строки “#FFCC99” в формат, принимаемый для обозначения цвета фигур:

 Private Function HEX2RGB(ByVal HexColor As String) As String

    Dim Red As String

    Dim Green As String

    Dim Blue As String

    Dim Color As String

    Color = Replace(HexColor, "#", "")

    Red = Val("&H" & Mid(Color, 1, 2))

    Green = Val("&H" & Mid(Color, 3, 2))

    Blue = Val("&H" & Mid(Color, 5, 2))

    HEX2RGB = RGB(Red, Green, Blue)

End Function

Вызов формы

Для вызова формы нужно добавить небольшой модуль со скриптом вызова формы для SlidesProgressBar:

 Sub ShowSlidesProgressBarDialog()

    SlidesProgressBarForm.Show

End Sub

Добавление вызова формы на ribbon-ленту

Чтобы добавить вызов нашей формы на ленту нужно через то же самое меню кастомизации ленты выбрать в списке источников макросы (Macros) и соответствующую функцию, а в списке табов создать собственную секцию.

После этого нажать Add, чтобы добавить команду. Там же можно переименовать и поменять иконку.