How to access slides from a VBA addin

P

peterfarge

Hallo Usenet,

I have created an AddIn with a commandbar (toolbar) and want to add my
own icons. The problem is that I dont know how to access a slide while
my project is saved as an addin. On the slide lies my icon...

This is the code I'm using to add the toolbar:
Public Sub auto_load()
Dim oComBar As CommandBar
Dim oComBarButton As CommandBarButton

On Error Resume Next
CommandBars("222").Delete
Set oComBar = Application.CommandBars.Add("222")

Set oComBarButton = oComBar.Controls.Add(msoControlButton)
oComBarButton.Style = msoButtonIcon
' Here is the problem:
Presentations("My_Presentation").Slides(1).Shapes("My_Icon").Copy
oComBarButton.PasteFace
oComBar.Visible = True
End Sub

If my project is loaded as an addin, than there is no Presentation
named "My_Presentation". And Application.AddIns(1) has no slides
property. Can anyone help me?


Peter
 
P

peterfarge

A workaround is the following: Place for every icon a imagebox on a
form and place them into the commanbar with the picture property of the
commandbarbutton.
 
P

peterfarge

Ok, here is the example code:

1. Create a form "UserForm1" with an image control named "Image1"
2. Load a picture in the image control.
3. Create a modul with this 3 functions:

Public Sub CreateCommandBar()
Dim oComBar As CommandBar
Const COMMANDBAR_NAME As String = "Test toolbar"

' Delete old toolbar:
For Each oComBar In CommandBars
If oComBar.Name = COMMANDBAR_NAME Then
oComBar.Delete
End If
Next oComBar

' Create new toolbar:
Set oComBar = Application.CommandBars.Add(COMMANDBAR_NAME)
Call AddButton(oComBar, "Button Caption",
"CMDBAR_FunctionDoSomething", UserForm1.Image1.Picture, True)
oComBar.Visible = True
End Sub

Private Sub AddButton(oComBar As CommandBar, sButtonName As String,
sMakroName As String, oIcon As IPictureDisp, bBeginGroup As Boolean)
Dim oComBarButton As CommandBarButton

Set oComBarButton = oComBar.Controls.Add(msoControlButton)
With oComBarButton
.Caption = sButtonName
.OnAction = sMakroName
.BeginGroup = bBeginGroup
.Style = msoButtonIcon
.Picture = oIcon
End With
End Sub

Public Sub CMDBAR_FunctionDoSomething()
MsgBox "Hello toolbar"
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top