Adding/removing object from the SlideMaster Toggle action

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

Code:

---

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

---

Maybe something based on this:

Code:

---

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

---

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

Code:

---


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

---

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

Best regards,
Philippe

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


Attachment 13183

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

Paul

The crest actually says...

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

BRILLIANT!

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:

Code:

---

Sub Callback6(control As IRibbonControl)
    Dim shp As Shape
    'Draft stamp on Master
    Set shp = Application.ActivePresentation.SlideMaster.Shapes.AddTextbox(msoTextOrientationHorizontal, 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:

Code:

---

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

You have slightly misunderstood how to add and find TAGS

Code:

---

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(msoTextOrientationHorizontal, 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

---

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/show...ssing-anywhere

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

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

When you have that try looking at thisAttachment 13589

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

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

Code:

---

'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

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

Quote:

---

Not a beginners project though

---

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