无法使用vba通过excel在power point中设置对象的位置

Question

我目前正在为 mac 2011 制作 excel 中的宏。宏的目标是在 power point 幻灯片中复制图表和范围。但是，每当我尝试使用 .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