PowerPoint Mac - Update Excel Links + Save as PDF

[Jaimers]

Hello,

I'm hoping someone can help me figure out how to update the macros below to work on a Mac (they work well on a PC).

This macro updates the file location of Excel linked charts and tables in a PowerPoint file (it's in the Excel file)

Sub LoopThruPP()


'****LOOPs THROUGH ALL PPT SLIDES AND UPDATES LINKS + SAVES AS PDF****
Dim MyXLFilePath As String
Dim MyPPFile As String
Dim MyPPFilePath As String
Dim PPPresName As String
Dim PDFName As String
Dim PDFFilePath As String
Dim MyWorkbook As Workbook
Dim PPApp As Object ' As PowerPoint.Application
Dim PPSlide As Object ' As PowerPoint.Slide
Dim PPShape As Object ' As PowerPoint.Shape
Dim ClosePPApp As Boolean
Dim SelfName As String
Dim MyPath As String
'Dim PPPres As PowerPoint.Presentation




'UPDATE FILE NAMES HERE
    PPPresName = "Feedback Report.pptm"
    PDFName = "Feedback Report.pdf"
    
    If Not Application.OperatingSystem Like "*Mac*" Then
        MyPath = ActiveWorkbook.Path & "/"
        MyPPFile = Dir(MyPath & PPPresName)
    Else
        MyPath = ActiveWorkbook.Path & ":"
        MyPPFile = MyPath & PPPresName
        'MsgBox (MyPPFile)
        
        If FileOrFolderExistsOnMac(1, MyPPFile) = False Then
            MyPPFile = ""
        End If
    End If
    
  
'ACTIVE WORKBOOK PATH + NAME
    MyXLFilePath = ThisWorkbook.FullName
    Set MyWorkbook = ThisWorkbook
    'MsgBox (MyXLFilePath)


'LINKED PP PATH PDF PATH + NAME
    MyPPFilePath = MyPath & PPPresName
    PDFFilePath = MyPath & PDFName


    
'CHECK IF PP EXISTS
    If MyPPFile = "" Then
        MsgBox ("It appears the Power Point Presentation, '" & PPPresName & "', is missing or the name has been changed. " & _
        "Please double check that the file is saved in the same location as the Excel template and the name matches with the above.")
        Exit Sub
    End If


'REFERENCE PP APP
    On Error Resume Next
    'reference existing instance of PowerPoint
    Set PPApp = GetObject(, "Powerpoint.Application")
    'if PowerPoint not open, set app
    If PPApp Is Nothing Then
        Set PPApp = CreateObject("Powerpoint.Application")
        PPApp.Visible = True
        ClosePPApp = True
    End If


'REFERENCE PP PRESENTATION
    Set PPPres = PPApp.Presentations.Open(MyPPFilePath, WithWindow:=msoTrue, ReadOnly:=msoFalse)
    PPPres.Activate
    PPPres.WindowState = xlMinimized


'UPDATE PP LINKS SOURCE AND REFRESH
    'PPPres.UpdateLinks
      
    'loop through shapes on slides
    For Each PPSlide In PPPres.Slides
        For Each PPShape In PPSlide.Shapes
            'check if shape is linked to chart
            If PPShape.Type = msoChart Then
                If PPShape.Chart.ChartData.IsLinked = True Then
                    LinkedChart = True
                End If
            End If
            'check if shape is linked to table
            If PPShape.Type = msoLinkedOLEObject Then
                LinkedTable = True
            End If
    
            If LinkedChart = True Or LinkedTable = True Then
                With PPShape.LinkFormat
                    SrcName = .SourceFullName
                    IndexNum = InStr(1, SrcName, "!")
                    'reset source file
                    If IndexNum > 0 Then
                        NewPath = MyXLFilePath & Mid(SrcName, IndexNum, Len(SrcName) - IndexNum + 1)
                    Else
                        NewPath = MyXLFilePath
                    End If
                    .SourceFullName = NewPath
                    'refresh links
                    .Update
                End With
            End If
            
            'move table to top of slide
            If LinkedTable = True Then
                If PPShape.Name <> "NotApplicable" Then
                    PPShape.Top = 80
                End If
            End If
            
            LinkedChart = False
            LinkedTable = False
        Next PPShape
    Next PPSlide
    
    'loop through shapes on slide master
    For Each PPShape In PPPres.SlideMaster.Shapes
        If PPShape.Type = msoLinkedOLEObject Then
                 With PPShape.LinkFormat
                    SrcName = .SourceFullName
                    IndexNum = InStr(1, SrcName, "!")
                    'reset source file
                    If IndexNum > 0 Then
                        NewPath = MyXLFilePath & Mid(SrcName, IndexNum, Len(SrcName) - IndexNum + 1)
                    Else
                        NewPath = MyXLFilePath
                    End If
                    .SourceFullName = NewPath
                    'refresh links
                    .Update
                End With
        End If
    Next PPShape
          
'SAVE UPDATES AND SAVE AS PDF
    SelfName = Range("SelfName").Value
    
    PPPres.Save
    PPPres.Activate
    PPApp.Run PPPresName & "!PrintToPDF.PrintToPDF", MyPPFilePath, ClosePPApp, SelfName


'CLEAN UP
    MyPPFile = Dir()
    PPPres = Nothing
    PPApp = Nothing
    ClosePPApp = False


MyWorkbook.Activate
MsgBox ("Report Created!")
  
End Sub

And this macro is called from the above and saved in the powerpoint file, it saves the file as a PDF:

Sub PrintToPDF()
Dim PDFName As String
Dim CoachSlide As Slide


'MyPPFilePath = ActivePresentation.FullName
'SelfName = "NAME TEST"


'export coach PDF
PDFName = Left(MyPPFilePath, Len(MyPPFilePath) - 5) & " - " & SelfName & " (COACH)" & ".pdf"
'MsgBox (PDFName)
ActivePresentation.ExportAsFixedFormat PDFName, ppFixedFormatTypePDF, ppFixedFormatIntentPrint


'hide coach slides
For Each CoachSlide In ActivePresentation.Slides
    If CoachSlide.Tags("COACH") = "Yes" Then
        CoachSlide.SlideShowTransition.Hidden = msoTrue
    End If
Next CoachSlide


'export self PDF
PDFName = Left(MyPPFilePath, Len(MyPPFilePath) - 5) & " - " & SelfName & ".pdf"
ActivePresentation.ExportAsFixedFormat Path:=PDFName, FixedFormatType:=ppFixedFormatTypePDF, RangeType:=ppFixedFormatIntentPrint


ActivePresentation.Close


'MsgBox (ClosePPApp)
If ClosePPApp = True Then
 PowerPoint.Application.Quit
End If


End Sub

Any help would be so much appreciated!!

Thanks!