PowerPoint VBA で Azure Architecture Icons Deck を生成する

Azure Architecture Icons をコピー＆ペーストしやすいように PowerPoint VBA で並べてみたのでその方法をメモっとく。

AWS Architecture Icons は PowerPoint 形式で配布されているのに Azure Architecture Icons は PowerPoint 形式で配布されてないよね？ということで、PowerPoint VBA に初挑戦してマクロを書いてみた。

生成結果

背景画像は生成後に手作業で追加しています。

使用方法

1. Azure Architecture Icons から Azure の SVG アイコンをダウンロードおよび展開する
2. 後述するコードを PowerPoint の Visual Basic Editor に標準モジュールとして貼り付ける
3. コードの ICON_SIZE を16から32までの範囲を目安に設定する
4. PowerPoint のマクロから CreateAzureArchitectureIconsDeck を実行する
5. フォルダーの参照ダイアログが表示されるので Icons フォルダーを選択する
   
6. アイコンを並べたスライドが生成される

コード

Option Explicit

Const ICON_SIZE As Integer = 21

Sub CreateAzureArchitectureIconsDeck()
    Dim Index As Integer
    Dim Folder As Object
    For Each Folder In IconsFolder.SubFolders
        InsertHeading Index, Folder
        Index = Index + 1

        Dim File As Object
        For Each File In Folder.Files
            InsertIcon Index, File
            Index = Index + 1
        Next
    Next
End Sub

Function IconsFolder() As Object
    Set IconsFolder = CreateObject("Scripting.FileSystemObject").GetFolder(IconsFolderPath)
End Function

Function IconsFolderPath() As String
    IconsFolderPath = CreateObject("Shell.Application").BrowseForFolder(0, "Choose ""Icons"" folder...", 0).Self.Path
End Function

Function InsertHeading(Index As Integer, Folder As Object)
    If IsFilled(Index) Then InsertSlide

    Dim Heading As Shape: Set Heading = LastSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, PositionX(Index), PositionY(Index), ICON_SIZE * 5, ICON_SIZE)
    Heading.TextFrame.AutoSize = ppAutoSizeNone
    Heading.TextFrame.MarginBottom = 0
    Heading.TextFrame.MarginLeft = 0
    Heading.TextFrame.MarginTop = 0
    Heading.TextFrame.TextRange.Text = Folder.Name
    Heading.TextFrame.VerticalAnchor = msoAnchorMiddle
    Heading.TextEffect.FontName = "Segoe UI Semibold"
    Heading.TextEffect.FontSize = ICON_SIZE * 0.4375
End Function

Function InsertIcon(Index As Integer, File As Object)
    If IsFilled(Index) Then InsertSlide

    LastSlide.Shapes.AddPicture File.Path, False, True, PositionX(Index), PositionY(Index), ICON_SIZE, ICON_SIZE

    Dim Label As Shape: Set Label = LastSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, PositionX(Index) + ICON_SIZE, PositionY(Index), ICON_SIZE * 4, ICON_SIZE)
    Label.TextFrame.TextRange.Text = GenerateLabel(File)
    Label.TextEffect.FontName = "Segoe UI"
    Label.TextEffect.FontSize = ICON_SIZE * 0.25
End Function

Function IsFilled(Index As Integer) As Boolean
    IsFilled = Index Mod Capacity = 0
End Function

Function Capacity() As Integer
    Capacity = Rows * Columns
End Function

Function Rows() As Integer
    Rows = (ActivePresentation.PageSetup.SlideHeight - ICON_SIZE * 2) \ ICON_SIZE
End Function

Function Columns() As Integer
    Columns = (ActivePresentation.PageSetup.SlideWidth - ICON_SIZE * 2) \ (ICON_SIZE * 5)
End Function

Function InsertSlide()
    ActivePresentation.Slides.Add ActivePresentation.Slides.Count + 1, ppLayoutBlank
End Function

Function LastSlide() As Slide
    Set LastSlide = ActivePresentation.Slides.Item(ActivePresentation.Slides.Count)
End Function

Function PositionX(Index As Integer) As Integer
    PositionX = ((Index Mod Capacity) \ Rows) * ICON_SIZE * 5 + MarginX
End Function

Function MarginX() As Integer
    MarginX = (ActivePresentation.PageSetup.SlideWidth - ICON_SIZE * 5 * Columns) / 2
End Function

Function PositionY(i As Integer) As Integer
    PositionY = (i Mod Capacity Mod Rows) * ICON_SIZE + MarginY
End Function

Function MarginY() As Integer
    MarginY = (ActivePresentation.PageSetup.SlideHeight - ICON_SIZE * Rows) / 2
End Function

Function GenerateLabel(File As Object) As String
    GenerateLabel = IconNumber(File.Name) & " " & IconTitle(File.Name)
End Function

Function IconNumber(Filename As String) As String
    IconNumber = Split(Filename, "-")(0)
End Function

Function IconTitle(Filename As String) As String
    Dim Words() As String: Words = Split(StripExtension(Filename), "-")
    Dim Index As Integer
    For Index = 3 To UBound(Words)
        Words(Index - 3) = Words(Index)
    Next
    ReDim Preserve Words(UBound(Words) - 3)
    IconTitle = Join(Words, " ")
End Function

Function StripExtension(Filename As String) As String
    StripExtension = Split(Filename, ".")(0)
End Function

書き捨てのコードなので品質はご容赦ください。

参考文献

パーフェクト Excel VBA
PowerPoint VBA Reference