TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

این ماکرو یک نوار ابزار popup به اسلاید اضافه می کند

Sub CreateThePopup()

    Dim oCmdBar As CommandBar
    Dim oCtrl As CommandBarControl

    ' delete the popup if it already exists
    For Each oCmdBar In Application.CommandBars
        If UCase(oCmdBar.Name) = UCase("myPopup") Then
            oCmdBar.Delete
            Debug.Print "Found/Deleted existing popup"
        Else
            Debug.Print oCmdBar.Name
        End If
    Next ' commandbar

    Set oCmdBar = Application.CommandBars.Add(Name:="myPopup", Position:=msoBarPopup)

    With oCmdBar
        ' Add a SAVE button
        Set oCtrl = .Controls.Add(Type:=msoControlButton, Id:=3)

        'add a Do Stuff button that calls your doStuff subroutine (see below)
        Set oCtrl = .Controls.Add(Type:=msoControlButton)
         With oCtrl
             .FaceId = 10
             .Caption = "Do stuff"
             .OnAction = "doStuff"
         End With

    End With

End Sub

Sub DisplayMyPopup()
' Call this sub to display the popup
    Application.CommandBars("myPopUp").ShowPopup
End Sub

Sub doStuff()
    MsgBox "I did stuff"
End Sub

روش بدست آوردن ID مورد نیاز:

Set oCtrl = .Controls.Add(Type:=msoControlButton, Id:=3)

Sub زیر هم little bit ، لیستی از ID ها را ارائه می کند.

Sub ListIDs()

  Dim oCtl as CommandBarControl
  Dim oCmdBar as CommandBar
  Dim sFileName as String
  Dim iFileNum as Integer

  ' Change this if you'd rather put the file elsewhere
  sFileName = "C:\temp\PowerPointIDs.TXT"

  iFileNum = FreeFile()
  Open sFileName For Output As iFileNum

  For Each oCmdBar In Application.CommandBars
    Print #iFileNum, oCmdBar.Name
    For Each oCtl In oCmdBar.Controls
      Print #iFileNum, oCtl.Id & vbTab & oCtl.Caption
    Next
  Next

  Close iFileNum

End Sub