VBA Ajout d'un objet Worksheet dans une presentation

[Carnage029]

Bonjour a tous,

Je cherche a completer un fichier sur lequel je travaille qui permet de creer des rapports de maniere automatise.

Une des derniere etape consisterai a ajouter dans le Powerpoint final cree (en VBA), une des worksheet du classeur sur lequel je travaille (contenant le VBA).

le but est d'arriver a rejouter une worksheet, avec une miniature du meme type que si on allait sur powerpoint, Insert -> Object -> Microsoft Excel Workbook

J'aimerai beaucoup me passer de l'etape ou je dois separer ma worksheet de mon classeur, la sauver et l'attacher.

Existe t'il une methode ? Pour l'instant j'ai trouve ca:

http://peltiertech.com/Excel/XL_PPT.html et http://www.tek-tips.com/faqs.cfm?fid=4833

la ligne suivante de code ajoute bien la miniature mais avec une nouveau classeur et non pas une worksheet de mon claseur.

Set objPPTShape = PPPres.Slides(1).Shapes.AddOLEObject(Left:=100, Top:=100, Width:=200, Height:=300, ClassName:="Excel.Sheet", DisplayAsIcon:=True)

Par avance, merci beaucoup,

Carnage029

 

[STephane]

Bonjour

Voilà une proposition de solution

Sub XLD_PowerpointEmbeddedSpreadsheet()
'#XLD 07/29/2017 https://www.excel-downloads.com/threads/vba-ajout-dun-objet-worksheet-dans-une-presentation.20017558/
Dim PPApp 'As PowerPoint.Application
Dim PPPres 'As PowerPoint.Presentation
Dim PPSlide 'As PowerPoint.Slide

Dim objPPTShape 'As OLEObject
Dim sWSH_Active As String
Dim wbTemp As Workbook
Dim wbMain As Workbook
Set wbMain = ActiveWorkbook
sWSH_Active = ActiveSheet.name
' Create instance of PowerPoint
Set PPApp = CreateObject("Powerpoint.Application")

' For automation to work, PowerPoint must be visible
' (alternatively, other extraordinary measures must be taken)
PPApp.Visible = True

' Create a presentation
Set PPPres = PPApp.presentations.Add

' Adding first slide of presentation
PPApp.ActiveWindow.View.GotoSlide index:=PPApp.ActivePresentation.Slides.Add(index:=1, Layout:=12).SlideIndex

' Some PowerPoint actions work best in normal slide view
'PPApp.ActiveWindow.ViewType = ppViewSlide
'Set PPSlide = PPPres.Slides.Add(1)

'# Adding OLE object type "Excel.Sheet" (or other type ?)
Set objPPTShape = PPPres.Slides(1).Shapes.AddOLEObject(left:=100, top:=100, Width:=200, Height:=300, ClassName:="Excel.Sheet", DisplayAsIcon:=True)

'# XLD 07/29/2017
'# Opening newly incorporated spreadsheet
With objPPTShape
    For Each sVerb In .OLEFormat.ObjectVerbs
        nCount = nCount + 1
       
        If sVerb = "Edition" Then 
            .OLEFormat.DoVerb nCount
             Exit For
        End If
    Next sVerb

End With

DoEvents
'# XLD 07/29/2017
'# Memorizing the Powerpoint embedded spreadsheet
'# to copy desired worksheet into it, and, then closing & save its changes
Set wbTemp = ActiveWorkbook
wbMain.Worksheets(sWSH_Active).Copy After:=wbTemp.Sheets(1)
wbTemp.Close (True)
End Sub