VBA Office

'Standard Module: Module1

Option Explicit

Public Sub TestSub()
    MsgBox "TestSub"
End Sub

'ThisWorkbook Module

Option Explicit

Private Sub Workbook_Open()

    On Error Resume Next

    Dim CBC As Office.CommandBarControl
    Set CBC = Application.CommandBars("Cell").Controls.Add(Temporary:=True)

    CBC.Caption = "Test Command Bar Control"
    CBC.OnAction = "TestSub"

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    On Error Resume Next

    Application.CommandBars("Cell").Controls("Test Command Bar Control").Delete

End Sub

Public Sub PrintAllCommandBarsAndControls()

    Dim WS As Worksheet
    Set WS = ThisWorkbook.Worksheets.Add

    Dim r As Long
    r = 1

    Dim c As Long
    c = 1

    Dim CB As Office.CommandBar
    For Each CB In Application.CommandBars

        Dim CBC As Office.CommandBarControl

        WS.Cells(r, c).Value2 = CB.Name

        For Each CBC In CB.Controls

            RecurseControl r, c + 1, WS, CBC

        Next CBC

    Next CB

End Sub

Private Sub RecurseControl(r As Long, c As Long, _
WS As Worksheet, CBC As Office.CommandBarControl)

    On Error GoTo StopRecurring

    WS.Cells(r, c).Value2 = CBC.Caption

    Dim CBC1 As Office.CommandBarControl

    For Each CBC1 In CBC.Controls
        RecurseControl r, c + 1, WS, CBC1
    Next CBC1

StopRecurring:

    If Err.Number <> 0 Then
        r = r + 1
    End If

End Sub

Public Sub PrintUndoList()

    On Error GoTo ExitSub

    Dim i As Long
    Do While True
        i = i + 1
        Debug.Print Application.CommandBars("Standard").Controls("&Undo").List(i)
    Loop

ExitSub:

End Sub

Public Sub Example()

    Dim FD As Office.FileDialog
    Set FD = Application.FileDialog(msoFileDialogFilePicker)

    With FD
        .AllowMultiSelect = False
        .ButtonName = "Select File"
        .Filters.Clear
        .Filters.Add "All Files", "*.*"
        .Filters.Add "Excel Files", "*.xl*"
        .FilterIndex = 1
        .InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
        .Title = "Select a File"
        If .Show Then
            Dim FilePath As String
            FilePath = .SelectedItems(1)
        End If
    End With

    If FilePath <> "" Then
        Debug.Print FilePath
    Else
        Debug.Print "No File Selected"
    End If

End Sub

Public Sub Example()

    Dim FD As Office.FileDialog
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)

    With FD
        .ButtonName = "Select Folder"
        .InitialFileName = Environ$("USERPROFILE") & "\Desktop\"
        .Title = "Select a Folder"
        If .Show Then
            Dim FolderPath As String
            FolderPath = .SelectedItems(1)
        End If
    End With

    If FolderPath <> "" Then
        Debug.Print FolderPath
    Else
        Debug.Print "No Folder Selected"
    End If

End Sub

Public Sub Example()

    Dim LayoutId As String
    LayoutId = "urn:microsoft.com/office/officeart/2005/8/layout/orgChart1"

    Dim Layout As Office.SmartArtLayout
    Set Layout = PowerPoint.Application.SmartArtLayouts(LayoutId)

    Dim S As PowerPoint.Slide
    Set S = PowerPoint.Application.Presentations(1).Slides(1)

    Dim SH As PowerPoint.Shape
    Set SH = S.Shapes.AddSmartArt(Layout)

    Dim SA As Office.SmartArt
    Set SA = SH.SmartArt

End Sub

Public Sub Example()

    Dim LayoutId As String
    LayoutId = "urn:microsoft.com/office/officeart/2005/8/layout/orgChart1"

    Dim Layout As Office.SmartArtLayout
    Set Layout = Excel.Application.SmartArtLayouts(LayoutId)

    Dim WS As Excel.Worksheet
    Set WS = Excel.Workbooks(1).Worksheets(1)

    Dim S As Excel.Shape
    Set S = WS.Shapes.AddSmartArt(Layout)

    Dim SA As Office.SmartArt
    Set SA = S.SmartArt

End Sub

Public Sub Example()

    Dim LayoutId As String
    LayoutId = "urn:microsoft.com/office/officeart/2005/8/layout/orgChart1"

    Dim Layout As Office.SmartArtLayout
    Set Layout = Word.Application.SmartArtLayouts(LayoutId)
    
    Dim S As Word.Shape
    Set S = ThisDocument.Shapes.AddSmartArt(Layout)

    Dim SA As Office.SmartArt
    Set SA = S.SmartArt

End Sub

Public Sub Example()

    Dim WS As Worksheet
    Set WS = ActiveSheet

    Dim i As Long
    For i = 1 To Application.SmartArtLayouts.Count
        With Application.SmartArtLayouts(i)
            WS.Cells(i, 1).Value = .Name
            WS.Cells(i, 2).Value = .ID
            WS.Cells(i, 3).Value = .Description
            WS.Cells(i, 4).Value = .Application
            WS.Cells(i, 5).Value = .Category
            WS.Cells(i, 6).Value = .Creator
            WS.Cells(i, 7).Value = .Parent
        End With
    Next i

End Sub