无法使用VBA通过Excel在Power Point中设置对象的位置

Question

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

Answer 1

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