I'm currently working on a macro in excel for mac 2011. The goal of the macro is to copy charts and range in power point slide. However, whenever I try to set the position using the .Left property, it reset the value of said property to zero. I don't why i does that. Maybe it's because I'm using a mac edition. But I can't seem to find someone with the same issue as me. Could you help me to correct to code I'm using if there's an error or at least try to find a workaround? I appreciate any help from you guys.
Here my code :
Option Explicit
Sub Presentation()
Application.ScreenUpdating = False
'Variable
Dim i As Integer
Dim tot As Integer
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.slide
Dim cht As Excel.ChartObject
Dim tbl As Range
Dim sChart As Chart
tot = InputBox("Saisir le nombre de slide voulu : ", "Nombre de Slides")
i = 1
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Create a power point
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Create presentation
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If
'Show presentation
newPowerPoint.Visible = True
'Loops through each worksheet named 1 , 2 ...
While i <= tot
'Activate the i worksheet
Worksheets(CStr(i)).Activate
'Add a slide
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
'Get title
activeSlide.Shapes(1).TextFrame.TextRange.Text = Range("A1").Value
'Ajust title position
activeSlide.Shapes(1).Left = 0
activeSlide.Shapes(1).Top = 0
'Loops through each charts in the sheet
For Each cht In ActiveSheet.ChartObjects
cht.Select
'Copie/Colle le graphique
ActiveChart.ChartArea.Copy
activeSlide.Shapes.Paste.Select
'Ajust the chart's position to bottom right
With newPowerPoint.ActiveWindow.Selection.ShapeRange
.Align msoAlignRights, msoTrue
.Align msoAlignBottoms, msoTrue
End With
Next
'Copy / Paste the range
Set tbl = ActiveSheet.Range("B1").CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
Selection.Copy
With activeSlide.Shapes.Paste
'HERE'S THE PROBLEM
.Width = 300 'The value of width is now set to 0 instead of 300
.Height = 300 'The value of height is now set to 0 instead of 300
.Left = 720 'The value of left is now set to 0 instead of 720
.Top = 888 'The value of top is now set to 0 instead of 888
End With
i = i + 1
Wend
Application.ScreenUpdating = True
AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing
End Sub
Please help me, I can't seem to find any solution and please excuse me if I'm not clear enough because I am french and english isn't my natural language.
Thanks in advance
Try this:
'paste
activeSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set activeSlideShapeRange = activeSlide.Shapes(activeSlide.Shapes.Count)
'position:
activeSlide.Left = 234
activeSlide.Top = 186
'empty clipboard
Application.CutCopyMode = False
HTH
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.