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???


ppt-jedi.jpg

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(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:

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

[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/show...ssing-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)toggle.pptm

[John Wilson]

When you have that try looking at thisnewToggle.pptm

[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.