Adding/removing object from the SlideMaster Toggle action

[Exposian]

Hi all!

Needing a little help from expert... I am trying to create a toggle to add and remove an object onto the slide Master.

I managed to create the action to add to the Slide Master but would need some help to create the toggle action to remove that same object. See my code below... Can anyone help?

Kindest regards,
Philippe



Sub AddBaseline()


On Error GoTo ErrorHandler
getMyInitials
Dim s As String, p As Presentation, o As Shape
s = "C:\Users\" & MyInitials & "\AppData\Roaming\Microsoft\Templates\Baseline.pptx"
Set p = Presentations.Open(s, ReadOnly:=True, WithWindow:=msoFalse)
p.Slides(1).Shapes.Range().Copy
p.Close
ActivePresentation.SlideMaster.Shapes.Paste
Exit Sub

ErrorHandler:
MsgBox ("Please verify if the file was renamed, moved or is missing")

End Sub

[John Wilson]

Maybe something based on this:


Sub AddBaseline()
Dim s As String, p As Presentation, o As Shape
Dim shpR As ShapeRange
Dim shp As Shape
Dim L As Long
Dim b_found As Boolean

On Error GoTo ErrorHandler
For L = ActivePresentation.SlideMaster.Shapes.Count To 1 Step -1
If ActivePresentation.SlideMaster.Shapes(L).Tags("DELETE") = "YES" Then
ActivePresentation.SlideMaster.Shapes(L).Delete
b_found = True
End If
Next L

If b_found Then Exit Sub

' getMyInitials

s = Environ("APPDATA") & "\Microsoft\Templates\Baseline.pptx"
Set p = Presentations.Open(s, ReadOnly:=True, WithWindow:=msoFalse)
p.Slides(1).Shapes.Range().Copy
p.Close
Set shpR = ActivePresentation.SlideMaster.Shapes.Paste
For Each shp In shpR
shp.Tags.Add "DELETE", "YES"
Next
Exit Sub

ErrorHandler:
MsgBox ("Please verify if the file was renamed, moved or is missing")

End Sub

[Exposian]

Hi All,

This is where I got to. I now need to make this work on the Master Slide instead of the slide. Does anyone know what needs changing?

Regards,
Philippe




Sub AddBaseline()


Dim oSl As Slide
Dim oSh As Shape

For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If oSh.Tags("Baseline") = "YES" Then
' Make the visible hidden,
' or the hidden visible
oSh.Visible = Not oSh.Visible
End If
Next
Next
Exit Sub


End Sub

[Exposian]

Amazing stuff! I can't thank you enough for your help on this. You are truly a VBA master!

Best regards,
Philippe

[Paul_Hossler]

You've never seen John's family crest???


13183

But, seriously JW is a valuable resource to all of us struggling with the PP object model

[John Wilson]

Paul

The crest actually says...

"If it's impossible it WILL take longer!"

[Exposian]

BRILLIANT!

[RandomGerman]

Hi there,

as I didn't manage to bring a toggle button (for adding/removing a shape to/from the slidemaster) to work using XML by now, I thought: Ok, create two buttons. One to add it, one to delete. I managed adding, and for deleting I tried to use John's masterpiece of code written above. But, although debugging doesn't say anything, I must have made a mistake, because it always jumps to the message box. And, once again, I'm too blind to find it ...

The code to add:

Sub Callback6(control As IRibbonControl)
Dim shp As Shape
'Draft stamp on Master
Set shp = Application.ActivePresentation.SlideMaster.Shapes.AddTextbox(msoTextOrienta tionHorizontal, Left:=39.118086, Top:=5.6692878, Width:=26.362188, Height:=21.826758)
With shp
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
.Name = "Draftmaster"

With .TextFrame
.TextRange.Text = "Draft"
.VerticalAnchor = msoAnchorTop
.MarginBottom = "3,685037"
.MarginLeft = "0"
.MarginRight = "0"
.MarginTop = "3,685037"
.WordWrap = msoFalse

With .TextRange
.Font.Size = 12
.Font.Name = "Arial"
.Font.Color.RGB = RGB(89, 171, 244)
.ParagraphFormat.Alignment = ppAlignLeft
End With
End With
End With
End Sub


The (obviously wrong) code to delete:

Public Sub Callback7(control As IRibbonControl)
Dim L As Long

On Error GoTo err
For L = ActivePresentation.SlideMaster.Shapes.Count To 1 Step -1
If ActivePresentation.SlideMaster.Shapes(L)("Draftmaster") = "YES" Then
ActivePresentation.SlideMaster.Shapes(L)("Draftmaster").Delete
End If
Next L

Exit Sub

err:
MsgBox "There is no draft sticker on the slidemaster"
End Sub

Does anyone see where I went wrong?

Thank you
Rob

[John Wilson]

You have slightly misunderstood how to add and find TAGS


Sub Callback7(control As IRibbonControl)
Dim L As Long

On Error GoTo err
For L = ActivePresentation.SlideMaster.Shapes.Count To 1 Step -1
'These two line to find and delete
If ActivePresentation.SlideMaster.Shapes(L).Tags("DRAFTMASTER") = "YES" Then
ActivePresentation.SlideMaster.Shapes(L).Delete
End If
Next L
Exit Sub
err:
MsgBox "There is no draft sticker on the slidemaster"
End Sub
Sub Callback6(control As IRibbonControl)
Dim shp As Shape
'Draft stamp on Master
Set shp = Application.ActivePresentation.SlideMaster.Shapes.AddTextbox(msoTextOrienta tionHorizontal, Left:=39.118086, Top:=5.6692878, Width:=26.362188, Height:=21.826758)
With shp
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
' This is how to add a tag
.Tags.Add "DRAFTMASTER", "YES"
'
With .TextFrame
.TextRange.Text = "Draft"
.VerticalAnchor = msoAnchorTop
.MarginBottom = "3,685037"
.MarginLeft = "0"
.MarginRight = "0"
.MarginTop = "3,685037"
.WordWrap = msoFalse

With .TextRange
.Font.Size = 12
.Font.Name = "Arial"
.Font.Color.RGB = RGB(89, 171, 244)
.ParagraphFormat.Alignment = ppAlignLeft
End With
End With
End With
End Sub

[RandomGerman]

Slightly. :-)

Again thank you so much, John. I would give my beard to have as much VBA expertise as you. :-)

Although this is great, I'd still prefer to get this thing solved with one toggle button - in case anyone is interested in the details, please look at this thread:
http://www.vbaexpress.com/forum/showthread.php?52762-Something-wrong-in-XML-Or-in-VBA-Or-something-missing-anywhere

Paul already tried to help me, but for some (yet unknown) reason his solution doesn't work, when I copy it.

[John Wilson]

Here's some homework then (not the most elegant solution but I tried to make it easier to understand)13587

[John Wilson]

When you have that try looking at this13589

[Exposian]

Hi John, really interesting looking at the code. Thank a lot for submitting that!

I was trying to look at how you built the ribbon and understand how the buttons are built but couldn't find reference inside your code.. could you quickly explain how you are controlling the appearance of the tick and cross marks?

Best regards,
Philippe

[John Wilson]

The XML ribbon code has both the tick and cross buttons. The visibility is controlled by this vba (and the similar code for the other button) so that only ONE shows at any time. The returnedVal sets visibilty to true or false.

myRibbon.Invalidate always checks this code and modifies the ribbon


'Callback for myToggleDEL getVisible
Sub getVisToggDEL(control As IRibbonControl, ByRef returnedVal)
Dim oshp As Shape
For Each oshp In ActivePresentation.SlideMaster.Shapes
If oshp.Tags("DRAFTMASTER") = "YES" Then
returnedVal = True
b_DELETE = True
Else
returnedVal = False
b_DELETE = False
End If
Next
End Sub

Not a beginners project though

[RandomGerman]

It's going to be an interesting weekend. Thank you, John.

[RandomGerman]

Not a beginners project though

No, definetely not ... thank you for this piece of work. I hope, I can take something out of it.