Giải thích giúp em code của file .ppa (Add-in của powerpoint)

Liên hệ QC

cuoilennaocacban

Thành viên mới
Tham gia
29/12/08
Bài viết
1
Được thích
0
Mã:
Option Explicit
Option Private Module
Global Const APP_NAME = "Animation Carbon"
Global Const APP_VERSION = "1.0"
Declare Function ShellExecute Lib "Shell32" Alias "ShellExecuteA" _
                              (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
                               ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As _
                                                                                          Long) As Long

Dim oSPFxSession As Object ' SPFx.cSPFx
Sub InitSession()
    Static Initialized As Boolean
On Error Resume Next
    If Not oSPFxSession Is Nothing Then
        If Initialized Then
            oSPFxSession.Show
        Else
            Call oSPFxSession.CallChildToolbar(Application)
            Initialized = True
        End If
    Else
        Set oSPFxSession = Nothing
        Set oSPFxSession = CreateObject("SPFx.cSPFx")
        If Not oSPFxSession Is Nothing Then
            Call oSPFxSession.CallChildToolbar(Application)
            Initialized = True
        Else
            MsgBox "Unable to create session"
        End If
    End If
    
End Sub


Sub Auto_Open()
    On Error Resume Next
    If Val(Application.Version) < 10 Then
        MsgBox APP_NAME & " requires PowerPoint 2002 or higher.", vbCritical, APP_NAME
        Exit Sub
    End If
    Dim PCSControl As CommandBarButton
    Dim oIconButt As CommandBarControl
    Dim IIPopUp As CommandBarPopup
    Dim CmdMenu As CommandBars
    Call Auto_Close
    Set CmdMenu = Application.CommandBars
    CmdMenu("View").FindControl(Tag:=APP_NAME & "Popup").Delete
        
    Set IIPopUp = CmdMenu("Tools") _
                     .Controls.Add(Type:=msoControlPopup, Temporary:=True)
    With IIPopUp
        .BeginGroup = True
        .Caption = "&" & APP_NAME
        .Tag = APP_NAME & "Popup"
    End With
    
    
    Set PCSControl = IIPopUp.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With PCSControl
        .Caption = "&About..."
        '.OnAction = Application.AddIns("IIW").Path & "\IIW.ppa!ShowAbout"
        .OnAction = "ShowSPFxAbout"
        .Tag = APP_NAME & "TagAbout"
        .Visible = True
    End With
    
    Set PCSControl = IIPopUp.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With PCSControl
        .BeginGroup = True
        .Caption = "&Show " & APP_NAME
        .OnAction = "InitSession"
        .Tag = APP_NAME & "Window"
        .Visible = True
    End With
    
    Set PCSControl = IIPopUp.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With PCSControl
        .Caption = APP_NAME & " Overview"
        .OnAction = "LaunchOverview"
        .Tag = APP_NAME & "Window"
        .Visible = True
    End With
    Set PCSControl = IIPopUp.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With PCSControl
        .Caption = APP_NAME & " Help"
        .Style = msoButtonIconAndCaption
        .OnAction = "LaunchHelp"
        .Tag = APP_NAME & "TagHelp"
        .Visible = True
        .BeginGroup = True
        Set oIconButt = CommandBars.FindControl(Type:=msoControlButton, Id:=984)
        oIconButt.CopyFace
        .PasteFace
    End With
    Set PCSControl = IIPopUp.Controls.Add(Type:=msoControlButton, Temporary:=True)
    With PCSControl
        .Caption = APP_NAME & " Home"
        .Style = msoButtonIconAndCaption
        .OnAction = "LaunchHome"
        .Tag = APP_NAME & "TagHelp"
        .Visible = True
    End With
    If GetSetting(APP_NAME, "Options", "FirstRun", "0") = "0" Then
        MsgBox "Select Tools | " & APP_NAME & " | Show " & APP_NAME & " to display the dialog. ", vbInformation, APP_NAME
        Call SaveSetting(APP_NAME, "Options", "FirstRun", "1")
    End If
    
    Call AddSCMenu("Shapes", "Draw")
    Call AddSCMenu("OLE Object", "Draw")
    Call AddSCMenu("Picture", "Draw")
    Call AddSCMenu("WordArt", "Draw")
    Call AddSCMenu("Connector", "Draw")
    Call AddSCMenu("Curve", "Draw")
    Call AddSCMenu("Curve Point", "Draw")
    Call AddSCMenu("Curve Segment", "Draw")
    Call AddSCMenu("Rotate Mode", "Draw")
    Call AddSCMenu("WordArt", "Draw")
    Call AddSCMenu("Tables", "Table")

    Set CmdMenu = Nothing
    On Error GoTo 0
End Sub

Sub ShowSPFxAbout()
    If Not oSPFxSession Is Nothing Then
        Call oSPFxSession.ShowAbout(Application)
    Else
        Set oSPFxSession = Nothing
        Set oSPFxSession = CreateObject("SPFx.cSPFx")
        If Not oSPFxSession Is Nothing Then
            Call oSPFxSession.ShowAbout(Application)
        Else
            MsgBox "Unable to display About dialog.", vbExclamation, APP_NAME
        End If
    End If
End Sub
Sub Auto_Close()
On Error Resume Next
CommandBars("Tools").FindControl(Tag:=APP_NAME & "Popup").Delete
If Not oSPFxSession Is Nothing Then
    oSPFxSession.CloseSession
    Set oSPFxSession = Nothing
End If
    Call DeleteSCMenu("Shapes", "Draw")
    Call DeleteSCMenu("OLE Object", "Draw")
    Call DeleteSCMenu("Picture", "Draw")
    Call DeleteSCMenu("WordArt", "Draw")
    Call DeleteSCMenu("Connector", "Draw")
    Call DeleteSCMenu("Curve", "Draw")
    Call DeleteSCMenu("Curve Point", "Draw")
    Call DeleteSCMenu("Curve Segment", "Draw")
    Call DeleteSCMenu("Rotate Mode", "Draw")
    Call DeleteSCMenu("WordArt", "Draw")
    Call DeleteSCMenu("Tables", "Table")
    
End Sub
Sub Launch(Path As String)
On Error Resume Next
ShellExecute 0, "Open", Path, "", "", 1
End Sub
Function AppendSeparator(Path As String, Optional ForwardSlash As Boolean = False) As String
    Const PATH_SEPARATOR_FORWARD = "/"
    Const PATH_SEPARATOR = "\"
    If Path = "" Then Exit Function
    If Not ForwardSlash Then
        AppendSeparator = IIf(Right(Path, 1) = PATH_SEPARATOR, Path, Path & PATH_SEPARATOR)
    Else
        AppendSeparator = IIf(Right(Path, 1) = PATH_SEPARATOR_FORWARD, Path, Path & PATH_SEPARATOR_FORWARD)
    End If
End Function

Sub LaunchHelp()
On Error Resume Next
Call Launch(AppendSeparator(AddIns("animcarbon.ppa").Path) & "animcarbon.chm")
End Sub
Sub LaunchHome()
On Error Resume Next
Call Launch("http://www.mvps.org/skp/ac/index.html")
End Sub
Sub LaunchOverview()
On Error Resume Next
Call Launch(AppendSeparator(AddIns("animcarbon.ppa").Path) & "animation carbon overview\index.html")

End Sub
Sub AddSCMenu(sName As String, Parent As String)
Dim cbCmdBarMenu As CommandBar
Dim cbMenu As CommandBarButton
Dim cbSubMenu As CommandBarPopup
Dim cbSubMenuSM As Object
Set cbCmdBarMenu = Application _
                   .CommandBars("Shortcut Menus")
Set cbSubMenu = cbCmdBarMenu.Controls(Parent)
Set cbSubMenuSM = cbSubMenu.Controls(sName)
' Add the new menu.
With cbSubMenuSM.Controls
    Set cbMenu = _
    .Add(Type:=msoControlButton)
    With cbMenu
        .OnAction = "InitSession"
        .Caption = APP_NAME & "..."
    End With
End With
End Sub

Sub DeleteSCMenu(sName As String, Parent As String)
On Error Resume Next
Dim cbCmdBarMenu As CommandBar
Dim cbSubMenu As CommandBarPopup
Dim cbSubMenuSM As Object
Set cbCmdBarMenu = Application.CommandBars("Shortcut Menus")
Set cbSubMenu = cbCmdBarMenu.Controls(Parent)
Set cbSubMenuSM = cbSubMenu.Controls(sName)
cbSubMenuSM.Controls(APP_NAME & "...").Delete
End Sub
 
Web KT
Back
Top Bottom