XL 2013 exporter automatiquement vers PPT un formulaire excel

oz2007 à dit:

...
J'ai mis l'image que je souhaite en PPT (sur ppt je souhaite un tableau excel pas une image)

Cliquez pour agrandir...

• soit incorporer les documents et dans ce cas ils seront indépendants de ta source actuelle et pèseront très lourd (200 classeurs dans le ppt)
• soit lier un ou des classeurs Excel ce qui permet l'actualisation en cas d'évolution de la source et n'alourdit pas le ppt.

• soit autant de tableaux Excel liés que de lignes,
• soit un code VBA en boucle qui change de ligne et
  • soit copie le tableau obtenu sous forme d'image dans PPT.
  • soit duplique une slide modèle et y inscrit les éléments dans les cases prévues (pas un format Excel mais un tableau PPt)
• VBA à relancer quand on veut une mise à jour...

1. vérifier le nombre de lignes et le nombres d'onglets
2. si pas d'autres onglets que la liste et le 1er onglet servant de modèle, portant comme nom le numéro de ligne (2) ou l'incluant sinon continuant la séquence et des formules utilisant ce numéro
3. Boucle dupliquant l'onglet modèle et le nommant selon le numéro de ligne traitée
4. Ouverture de la présentation.
5. Gestion des liaisons le cas échéant
6. Vérification du nombre de slides qui doit correspondre au nombre d'onglets tableaux avant le le 3.
7. Boucle d'ajout de slide et copie/collage spécial avec liaison de chaque onglet ajouter en 3.

Private Sub SpinButton1_Change()


Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PPTTemp As Object


Set PPTTemp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then PowerpointWasNotRunning = True
Err.Clear

' DetectExcel



PPTTemp.Application.Visible = True

If ExcelWasNotRunning = True Then
PPTTemp.Application.Quit
End If

' Reference instance of PowerPoint
On Error Resume Next

' Check whether PowerPoint is running
Set PPApp = GetObject(, "PowerPoint.Application")
If PPApp Is Nothing Then
' PowerPoint is not running, create new instance
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = True
End If
On Error GoTo 0

' Reference presentation and slide
On Error Resume Next
If PPApp.Windows.Count > 0 Then
' There is at least one presentation
' Use existing presentation
Set PPPres = PPApp.ActivePresentation
' Use active slide
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
Else
' There are no presentations
' Create new presentation
Set PPPres = PPApp.Presentations.Add
' Add first slide
'Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
End If
On Error GoTo 0

' Some PowerPoint actions work best in normal slide view
PPApp.ActiveWindow.ViewType = ppViewSlide

'Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex



Worksheets("AVEC PPT").Range("A1:G21").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

' Paste chart
PPSlide.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Left = 10
PPApp.ActiveWindow.Selection.ShapeRange.Top = 60
PPApp.ActiveWindow.Selection.ShapeRange.Width = 700



' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing




End Sub

Cliquez pour agrandir...

For i = 1 To 200

Cliquez pour agrandir...

Sub Macroautomatique()
'
' Macrotest Macro
'
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PPTTemp As Object


Set PPTTemp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then PowerpointWasNotRunning = True
Err.Clear

' DetectExcel



PPTTemp.Application.Visible = True

If ExcelWasNotRunning = True Then
PPTTemp.Application.Quit
End If

' Reference instance of PowerPoint
On Error Resume Next

' Check whether PowerPoint is running
Set PPApp = GetObject(, "PowerPoint.Application")
If PPApp Is Nothing Then
' PowerPoint is not running, create new instance
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = True
End If
On Error GoTo 0

' Reference presentation and slide
On Error Resume Next
If PPApp.Windows.Count > 0 Then
' There is at least one presentation
' Use existing presentation
Set PPPres = PPApp.ActivePresentation
' Use active slide
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
Else
' There are no presentations
' Create new presentation
Set PPPres = PPApp.Presentations.Add
' Add first slide
'Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
End If
On Error GoTo 0



For i = 1 To 200
Worksheets("Export Automatique").Range("I2").Formula = i



'Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count



Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex



Worksheets("Export Automatique").Range("A1:G21").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture

' Paste chart
PPSlide.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Left = 10
PPApp.ActiveWindow.Selection.ShapeRange.Top = 60
PPApp.ActiveWindow.Selection.ShapeRange.Width = 700

Next i



' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing




End Sub

Cliquez pour agrandir...