Sub Macromanuelle()
'
' Macro1 Macro
'
Dim oWdApp As Word.Application
Dim oWdDoc As Word.Document
Dim objWord As Object
Set objWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then WordWasNotRunning = True
Err.Clear
' Detectword
objWord.Application.Visible = True
If WordWasNotRunning = True Then
objWord.Application.Quit
End If
' Reference instance of PowerPoint
On Error Resume Next
' Check whether PowerPoint is running
Set oWdApp = GetObject(, "Word.Application")
If oWdApp Is Nothing Then
' PowerPoint is not running, create new instance
Set oWdApp = CreateObject("Word.Application")
oWdApp.Visible = True
End If
On Error GoTo 0
' Reference presentation and slide
On Error Resume Next
If oWdApp.Windows.Count > 0 Then
' There is at least one presentation
' Use existing presentation
Set oWdDoc = oWdApp.ActiveWorkbook
' Use active slide
Set oWdApp = CreateObject("Word.Application")
Else
' There are no presentations
' Create new presentation
Set oWdDoc = oWdApp.Documents.Add
' Add first slide
'Set PPSlide = oWdDoc.Slides.Add(1, ppLayoutBlank)
End If
On Error GoTo 0
'Add a new slide and paste in the chart
If oWdApp.Selection.PageSetup.Orientation = wdOrientPortrait Then
oWdApp.Selection.PageSetup.Orientation = wdOrientLandscape
Else
oWdApp.Selection.PageSetup.Orientation = wdOrientPortrait
End If
Worksheets("Export Manuel").Range("A1:T43").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture
' Paste chart
PPSlide.Shapes.Paste.Select
' Align pasted chart
DocWord.Range.PasteSpecial
Application.CutCopyMode = False
oWdApp.ActiveWindow.ActivePane.VerticalPercentScrolled = 0
objWord.Selection.InsertBreak Type:=7
End Sub