XL 2013 exporter automatiquement vers PPT un formulaire excel

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

Cliquez pour agrandir...

Sub ExportWordPDF()

Dim wdApp As Object
Dim wd As Object


On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Set wd = wdApp.Documents.Open("C:\frame.doc")

wdApp.Visible = True

Range("A1:T43").CopyPicture , xlBitmap
wd.Range.Paste [/B]

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.InsertBreak Type:=wdPageBreak



Set wdApp = Nothing
Set wd = Nothing



End Sub

Cliquez pour agrandir...

Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.InsertBreak Type:=wdPageBreak

Cliquez pour agrandir...

Sub ExportWordPDF()

Dim wdApp As Object
Dim wd As Object


On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0



wdApp.Visible = True
Set wd = wdApp.Documents.Open(ThisWorkbook.Path & Application.PathSeparator & "OSS_Axe2 Capi Services Existants_catalogue_v01.doc")


Range("A1:T43").CopyPicture , xlBitmap
wdApp.Selection.Paste


wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1
wdApp.Selection.TypeParagraph



Set wdApp = Nothing
Set wd = Nothing



End Sub

Cliquez pour agrandir...