PDA

View Full Version : Breaking Powerpoint slidemaster link from Excel vba + quick macro question



xcelintern
11-16-2016, 02:58 AM
Excel: 2010
PP: 2010
PP Reference in Excel: enabled

Hi guys,

I started an internship 2 weeks ago and after a week of basic excel I've been thrust into VBA last week(I have no clue about it).
Everything I've learned and done so far has been thanks to forums and other websites like this but for this particular problem I was unable to find a solution that I could fit to my project.

I am using the following code in Excel VBA to start a Powerpoint presentation from Excel and after updating all the links (40+) and breaking them after it is supposd to save the PP under whatever name it extracted from excel.

Problem is: it only breaks the links on all the slides but not the one link on the slidemaster (master slide?). It does update it though. Any other suggestions for my frankensteined code would also be greatly appreciated.



Sub OpenandsavecurrentPP()
Dim pApp As Object 'Powerpoint.Application'
Dim pPreso As Object
Dim sPreso As String
Dim objSlide As PowerPoint.Slide
Dim objShape As PowerPoint.Shape

' where the original pp is loaded '
sPreso = "M:\Business Development 2016.pptm"

On Error Resume Next
Set pApp = GetObject(, "PowerPoint.Application")

If Err.Number <> 0 Then
Set pApp = CreateObject("PowerPoint.Application")
pApp.Visible = True
End If

On Error Resume Next
Set pPreso = pApp.Presentations(sPreso)

If Err.Number <> 0 Then
Set pPreso = pApp.Presentations.Open(Filename:=sPreso)
End If

'where links are being updated'
On Error GoTo 0
pPreso.UpdateLinks


'If pPreso Is Nothing Then Exit Sub
'this is where the links are broken'
For Each objSlide In pPreso.slides
Application.StatusBar = "Breaking Object Links in " & pPreso.Name & ", slide: " & objSlide.Name
For Each objShape In objSlide.shapes
With objShape
If .Type = msoLinkedOLEObject Then
.LinkFormat.BreakLink
End If
End With
Next objShape
Set objShape = Nothing
Next objSlide
Set objSlide = Nothing
Application.StatusBar = True

pApp.Run "Business Development 2016.pptm!Modul1.example macro"

Dim FName As String
Dim FPath As String

'where pp is saved'
FPath = "M:\"

FName = Sheets("ge aktuell").Range("A1").Text


pApp.ActivePresentation.SaveAs FPath & FName & " BusinessDevelopment", 1




End Sub



The question I have about macros concerns the following line of code:

pApp.Run "Business Development 2016.pptm!Modul1.example macro"


This macro opens a window asking for an identification number (which i would like to extract and inject from my excel sheet as string) and then changing a picture on the title slide.

How could I adjust the code running the macro to also include the id number as string (which is present on excel sheet) that i now have to enter manually?

thanks in advance for your help, its greatly appreciated

Kenneth Hobs
11-16-2016, 12:00 PM
Welcome to the forum!

We would have to see that macro. In a simple example if ID was in say Sheet1.A1 where ID was from inputbox or application.inputbox or textbox in a userform:

'id = Inputbox(...)
id = Sheet1.[A1].Value 'codename method and bracket range method, or
id =Worksheets("Sheet1").Range("A1").Value 'Sheet name on tab method with Range A1 notation method.

xcelintern
11-17-2016, 12:22 AM
The macro code in question is currently opening an input box where you enter the 4 digit branch # and which then gets a picture from a predetermined folder based on that # and posts it to the current slide (title slide).

Now with the code I posted above you can see where i start the macro in question but instead of an input box i would like it to read the # from an excel cell in the worksheet that i also start the whole procedure to create this pp from.


Sub insert_picture()

Dim Nummer As String
Dim Objekt As Shape

Nummer = "0"

For Each Objekt In ActiveWindow.Selection.SlideRange.Shapes
If Objekt.Type = 13 Then '13=Bild
Objekt.Select
Objekt.Delete
End If
Next


Nummer = InputBox("Bitte Gebiets Nummer eingeben:")
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="C:\Bilder Gebiete\" _
& Nummer & ".jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=450, Top:=78, Width:=300, Height:=408).Select



End Sub

More importanty though i would greatly appreciate if any of you knew how to break the slidemaster link from vba, cause thats whats halting my automation most right now.

xcelintern
11-17-2016, 01:24 AM
All the methods I have found for breaking links from Excel VBA only work for regular slides and the slidemaster link always remains.

I found this as well which does not use the loop-through-each-slide method but couldnt get it to work for me, maybe you guys have an idea.


Set PPT = CreateObject("PowerPoint.Application")
PPT.ActivePresentation.Slides(i).Shapes(s).LinkFormat.BreakLink

xcelintern
11-17-2016, 04:22 AM
I did it, I finally broke the Slidemaster link from Excel after i was about to go crazy since nobody answered in the 4 Excel forums i posted this in across multiple languages.


pApp.ActivePresentation.SlideMaster.shapes(6).LinkFormat.BreakLink

Imho this isnt ideal as the Shape # is possibly subject to change in the future but for now its working as intended.

Come at me VBA.

Now if only I could get some help on my macro problem :-D

Kenneth Hobs
11-17-2016, 06:26 AM
Obviously, you need to change the sheet name and range for Nummer. Otherwise, it might go something like:


Sub insert_picture()
Dim Nummer As String, Objekt As Shape

Nummer = Worksheets("Sheet1").Range("A1").Value

For Each Objekt In ActiveWindow.Selection.SlideRange.Shapes
If Objekt.Type = 13 Then '13=Bild
Objekt.Select
Objekt.Delete
End If
Next

'Nummer = InputBox("Bitte Gebiets Nummer eingeben:")
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(Filename:="C:\Bilder Gebiete\" _
& Nummer & ".jpg", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=450, Top:=78, Width:=300, Height:=408).Select
End Sub




Sub OpenandsavecurrentPP()
'Dim pApp As Object 'Powerpoint.Application, late binding'
Dim pApp As PowerPoint.Application 'Powerpoint.Application, early binding'
Dim pPreso As Object, sPreso As String
Dim objSlide As PowerPoint.Slide, objShape As PowerPoint.Shape
Dim FName As String, FPath As String

' where the original pp is loaded '
sPreso = "M:\Business Development 2016.pptm"
'where pp is saved'
FPath = "M:\"
FName = Sheets("ge aktuell").Range("A1").Text

On Error Resume Next
Set pApp = GetObject(, "PowerPoint.Application")

If Err.Number <> 0 Then
Set pApp = CreateObject("PowerPoint.Application")
pApp.Visible = True
End If

On Error Resume Next
Set pPreso = pApp.Presentations(sPreso)

If Err.Number <> 0 Then
Set pPreso = pApp.Presentations.Open(Filename:=sPreso)
End If

'where links are being updated'
On Error GoTo 0
pPreso.UpdateLinks


'If pPreso Is Nothing Then Exit Sub
'this is where the links are broken'
For Each objSlide In pPreso.slides
Application.StatusBar = "Breaking Object Links in " & pPreso.Name & ", slide: " & objSlide.Name
For Each objShape In objSlide.Shapes
With objShape
If .Type = msoLinkedOLEObject Then
.LinkFormat.BreakLink
End If
End With
Next objShape
Set objShape = Nothing
Next objSlide
Set objSlide = Nothing
Application.StatusBar = True

On Error Resume Next
For Each objSlide In pApp.ActivePresentation.SlideMaster.Shapes
With objShape
If .Type = msoLinkedOLEObject Then
.LinkFormat.BreakLink
End If
End With
Next objShape
Next objSlide
On Error GoTo 0

pApp.Run "Business Development 2016.pptm!Modul1.example macro"

pApp.ActivePresentation.SaveAs FPath & FName & " BusinessDevelopment", 1
End Sub

xcelintern
11-17-2016, 06:48 AM
While the openandsavecurrentpp sub is running in excel VBA, the insert_picture one is a PP macro which i only start from excel on this line:


pApp.Run "Business Development 2016.pptm!Modul1.insert_picture"

And from pp i wont be able to just reference workbook and sheet without defining the excel app and other stuff again like I did for Powerpoint in Excel VBA if Im not mistaken.

Edit: This wouldnt have worked in PP but you gave me an idea and instead of a PP macro started from Excel VBA im now simply using Excel VBA for the whole operation which works like a charm.

Thanks bro