無法使用VBA通過Excel在Power Point中設置對象的位置

Question

我目前正在使用Mac 2011的excel宏。宏的目標是復制圖表並在PowerPoint幻燈片中進行調整。 但是，每當我嘗試使用.Left屬性設置位置時，都會將該屬性的值重置為零。 我不為什么我那樣做。 也許是因為我使用的是Mac版本。 但我似乎找不到與我有同樣問題的人。 如果出現錯誤，或者至少嘗試找到解決方法，您能否幫助我更正我正在使用的代碼？ 我感謝你們的任何幫助。

這是我的代碼：

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

請幫助我，我似乎找不到任何解決方法，如果我不太清楚，請原諒我，因為我是法語，英語不是我的自然語言。

提前致謝

Answer 1

嘗試這個：

'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