Modification Image exporte
Bonjour,
Alors mon problème, je pense, doit être simple à résoudre... mais pas assez simple pour moi, lol.
Je voudrais copier une sélection d'une feuille depuis Excel dans Ppt. Cette image je la voudrais sous format Bitmap, je voudrais également la redimensionner et la déplacer...
En ce qui concerne le copié/collé format bitmap, c'est good...
Mais je n'arrive pas à sélectionner mon image dans le fichier Ppt...
Pour ce qui est du dimensionement et déplacement, j'ai utiliser les macros directement...
Donc voici mon code avec en gras, là ou ça coince...
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
| Sub le_bon_pps2()
Set wdapp = CreateObject("powerpoint.application")
wdapp.Visible = True
Set doc = wdapp.Presentations.Add
Sheets("Scorecard_BU").Activate
ActiveSheet.Range("A1:P32").Select
Selection.Copy
wdapp.ActivePresentation.Slides.Add(Index:=1, Layout:=ppLayoutText).Select
'j'ai tenté de trouvé sur l'aide Micro mais j'ai pas saisi ce qu'étais layout... pplayoutLargeObject :s
wdapp.ActiveWindow.Selection.SlideRange.Layout = ppLayoutLargeObject
'Je supprime tous les shapes de la slide 1 pour ainsi n'avoir plus que mon image à sélectionner
wdapp.ActiveWindow.Selection.SlideRange.Shapes.SelectAll
wdapp.ActiveWindow.Selection.ShapeRange.Delete
'je ne saisis pas non plus à quoi sert IconLabel, sur l'aide ils disent que c'est pour donné un nom sous l'icone... mais je comprend pas ce qu'il veulent dire par la... j'ai essayé d'appeller l'image BSC pour l'appeller ensuite par ce nom... mais bon sa fonctionne poooo
Labelwdapp.ActiveWindow.View.PasteSpecial DataType:=ppPasteBitmap, DisplayAsIcon:=msoTrue, IconLabel:="BSC"
'j'ai fais un test directement et il me propose la solution qui suis, le problème est que cette fois l'image s'appelle Picture 5 mais la prochaine fois ce sera une autre picture XXX :s
wdapp.ActiveWindow.Selection.SlideRange.Shapes("Picture 5").Select
'C'est pourquoi je pense qu'il faudrait plutot un code comme suis ...
wdapp.ActiveWindow.Selection.Slide.OLEObject.SelectAll
With ActiveWindow.Selection
.Fill.Transparency = 0#
.LockAspectRatio = msoFalse
.Height = 510.12
.Width = 702.75
.Left = 8.5
.Top = 8.5
End With
End Sub |
Je pense qu'il y a pas grand chose à faire... mais j'ai testé tellement de truc et impossible de trouver la solution.
J'ai en réalité déjà demandé du coté Ppt, mais pas une réponse en 1 semaine... et c'est pour le boulot, je peux pas me permettra d'attendre bcp plus et malgré toutes mes recherches je suis bloqué :(
Voila je vous remercie par avance pour votre aide.
HAHAHAHAHAHA ENFIIIIINNNNNNN
Bonjour à vous !
MERCI MERCI MERCI MERCI MERCIIIIIIIIIi
Depuis le temps que j'attendais ça... je vous remercie vraiment.
Alors ta méthode de sélection Ouskeln' fonctionne impec.
Comme tu l'as dit, elle ne collait pas en format bitmap, mais j'ai juste récupéré ce que j'avais fait précédemment et c'est bon je copie une image et je la sélectionne
Voici le code
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
| Sub CollerPlageDeCellulesDansPowerPoint()
Dim AppPPT As Object
Dim DocPPT As Object
Dim LaDiapo As Object
Set AppPPT = CreateObject("PowerPoint.Application")
Set DocPPT = AppPPT.Presentations.Add
AppPPT.Visible = True
AppPPT.ActiveWindow.View.GotoSlide Index:=AppPPT.ActivePresentation.Slides.Add(Index:=1, Layout:=12).SlideIndex
Sheets("Scorecard_BU").Activate
ActiveSheet.Range("A1:P32").Select
Selection.Copy
AppPPT.ActiveWindow.View.PasteSpecial DataType:=ppPasteBitmap, DisplayAsIcon:=msoTrue, Iconlabel:="BSC"
'Sélection de l'objet Excel collé
AppPPT.ActiveWindow.Selection.SlideRange.Shapes(AppPPT.ActiveWindow.Selection.SlideRange.Shapes.Count).Select
'Mise en page
With AppPPT.ActiveWindow.Selection.ShapeRange
.Fill.Transparency = 0#
.LockAspectRatio = msoFalse
.Height = 510.12
.Width = 702.75
.Left = 8.5
.Top = 8.5
End With
'Enregistrement sous...
AppPPT.ActivePresentation.SaveAs Filename:="D:\ppt1.ppt"
AppPPT.ActivePresentation.Close
AppPPT.Quit
Set DocPPT = Nothing
Set AppPPT = Nothing
End Sub |
Juste une chose... que veux dire set ... = nothing ? :mrgreen:
Encore merci
