PowerPoint

Dim pepet As PowerPoint.Application
Dim curslide As PowerPoint.Slide
Dim xchart As Excel.ChartObject
Dim Hrrrep As PowerPoint.Application


Set pepet = New PowerPoint.Application

pepet.Visible = True

Filename = Application.ThisWorkbook.Path & "\HR_report012016_sampleforMacroFile.pptx"

pepet.Presentations.Open Filename, False, False, True 'tak otwieram prezentację

Wb.Sheets(1).ChartObjects("Slajd4").Activate 'wb to Workbook, który wcześniej zostal zdefiniowany
' dobrze jest najpierw zaznaczyć wykres (.activate), a dopiero potem dopiero kopiować
Wb.Sheets(1).ChartObjects("Slajd4").Copy


pepet.ActivePresentation.Slides(4).Shapes.Paste ‘’ wklejam wykres

If Month(Now() - 1) = 0 Then ‘' ustalam rok I miesią, który był miesiąc temu
miesiac = MonthName(12) ' styczeń – 1 = 0, dlatego trzeba to sprawdzić
rok = Year(Now() - 1)
Else
miesiac = MonthName(Month(Now()) - 1)
rok = Year(Now())
End If

Pepet.Activepresentation.Slides(1).Shapes("Subtitle 2").TextFrame.TextRange.Text = miesiac & " " & rok 'wpisuję dzień I rok do podtytułu slajdu
currentSlajd = getSlideNumber("Tytuł slajdu")
pepet.ActivePresentation.Slides(currentSlajd).Select
pepet.ActivePresentation.Slides(currentSlajd).Copy
pepet.ActivePresentation.Application.CommandBars.ExecuteMso ("PasteSourceFormatting") 'kopiuję slajd I wklejam pod spodem

Worksheets("Pivot68").Range("A38:" & Cells(lastrow, lastcolumn).Address).Copy 'kopiuję interensujący mnie fragment arkusz
pepet.ActivePresentation.Slides(currentSlajd + 1).Shapes.PasteSpecial ppPasteEnhancedMetafile '’wklejam do prezentacji, po czym ustawiam jego pozycję (wiem, że jest tylko tytuł, więc biorę 2gi kształt)


pepet.ActivePresentation.Slides(currentSlajd + 1).Shapes(2).Top = 111.2881
pepet.ActivePresentation.Slides(currentSlajd + 1).Shapes(2).Left = 19.75008

pepet.ActivePresentation.SaveAs Filename:=pdfname, FileFormat:=ppSaveAsPDF ' export prezentacji do PDF

Set oPres = Presentations.Open(Path & file)

With oPres
' każdy slajd na prezentacji
For Each oSld In .Slides
Debug.Print oSld.SlideNumber
Call SetLinksToManual(oSld)
Next
.Save
.Close


End With
Set oPres = Nothing


Sub SetLinksToManual(oSld As Object)
Dim oShp As PowerPoint.Shape
For Each oShp In oSld.Shapes
If oShp.Type = msoLinkedOLEObject Then
'zmiana na manualupdate
oShp.LinkFormat.AutoUpdate = ppUpdateOptionManual
End If
Next oShp
End Sub

Sub SetLinksToAutomatic(oSld As Object)
Dim oShp As PowerPoint.Shape
For Each oShp In oSld.Shapes
If oShp.Type = msoLinkedOLEObject Then
'zmiana łączy na autoupdate
oShp.LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
End If
Next oShp
End Sub



Sub updateslide(oSld As Object)
Dim oShp As PowerPoint.Shape
For Each oShp In oSld.Shapes
If oShp.Type = msoLinkedOLEObject Then
'aktualizuje łącza do slajdów
oShp.LinkFormat.Update
End If
Next oShp
End Sub

Sub breakslide(oSld As Object)
Dim oShp As PowerPoint.Shape
For Each oShp In oSld.Shapes
If oShp.Type = msoLinkedOLEObject Then
'zrywa łącza
oShp.LinkFormat.BreakLink
End If
Next oShp
End Sub

''' na koniec procudury usuwajacej łącza wstawiam takie coś, żebym potem wiedział kto mi psuje linki
On Error Resume Next
var = oPres.CustomDocumentProperties("Break").Value
If Err.Number > 0 Then
oPres.CustomDocumentProperties.Add Name:="Break", LinkToContent:=False, Type:=msoPropertyTypeString, Value:=VBA.Environ("username") ''nazwa użytkownika trafia do metafile data
End If
Err.Clear

Set oPres = Nothing