Question

我对VBA很新，我试图通过调整其他现有脚本来学习。

以下脚本我已经能够适应我的要求，除了滑动定位，因为它似乎将范围放在每张幻灯片上的powerpoint内一个完全不同的位置。我试图将对象设置为从左手侧和幻灯片顶部的设定距离完美对齐。

编码是否会出现明显错误的原因？

＆＃13;

Sub copiSylwadau()

'PURPOSE: Copy Excel Ranges and Paste them into the Active PowerPoint presentation slides
'SOURCE: www.TheSpreadsheetGuru.com

Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long

'Create an Instance of PowerPoint
  On Error Resume Next
    
    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    
    'Clear the error between errors
      Err.Clear

    'If PowerPoint is not already open then Exit
      If PowerPointApp Is Nothing Then
        MsgBox "PowerPoint Presentation is not open, aborting."
        Exit Sub
      End If
    
    'Handle if the PowerPoint Application is not found
      If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
      End If

  On Error GoTo 0
    
'Make PowerPoint Visible and Active
  PowerPointApp.ActiveWindow.Panes(2).Activate
    
'Create a New Presentation
  Set myPresentation = PowerPointApp.ActivePresentation
  
'List of PPT Slides to Paste to
  MySlideArray = Array(5, 7, 9, 11, 13, 15, 17, 18, 20, 22, 24, 26, 27, 28, 31)

'List of Excel Ranges to Copy from
    MyRangeArray = Array(Sheet4.Range("A1:A12"), Sheet9.Range("A1:A12"), Sheet10.Range("A1:A12"), Sheet11.Range("A1:A12"), Sheet12.Range("A1:A12"), Sheet13.Range("A1:A12"), Sheet14.Range("A1:A12"), Sheet15.Range("A1:A12"), Sheet16.Range("A1:A12"), Sheet17.Range("A1:A12"), Sheet18.Range("A1:A12"), Sheet19.Range("A1:A12"), Sheet20.Range("A1:A12"), Sheet21.Range("A1:A12"), Sheet22.Range("A1:A12"))

'Loop through Array data
  For x = LBound(MySlideArray) To UBound(MySlideArray)
    'Copy Excel Range
        MyRangeArray(x).Copy
    
    'Paste to PowerPoint and position
      On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.Paste
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange
                
      On Error GoTo 0
      
      'Center Object
      With myPresentation.PageSetup
        shp.Left = 20
        shp.Top = 40
        shp.Width = 679
            
    End With
      
     
  Next x


'Transfer Complete
  Application.CutCopyMode = False
  ThisWorkbook.Activate
  MsgBox "Cyflwyniad PowerPoint wedi eu greu!"

End Sub

＆＃13;

此外，我已经尝试了多种方法来设置要复制的范围内的文本的字体和大小，但无法使其正常工作。例如，尝试在＆＃34; myPresentation.PageSetup＆＃34;下面添加代码。命令，未被识别。

＆＃13;

        Shp.TextRange.Font.Size = 14
        Shp.TextRange.Font.Name = "Arial"

＆＃13;

任何正确方向的指针都将受到赞赏

Answer 1

尝试如下： PageSetup设置幻灯片大小，而不是幻灯片上形状的位置;你不需要弄乱它。

'Paste to PowerPoint and position
  On Error Resume Next
    Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.Paste
    Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange

  'Center Object
    shp.Left = 20
    shp.Top = 40
    shp.Width = 679

Answer 2

由于您只是将范围从Excel粘贴到Powerpoint，因此它将被粘贴为表格，您需要将其格式化。

     Dim lRow As Long
     Dim lCol As Long
     Dim oTbl As Table

        Set oTbl = shp.Table
            For lRow = 1 To oTbl.Rows.Count
                For lCol = 1 To oTbl.Columns.Count
                    With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange
                        .Font.Name = "Arial"
                        .Font.Size = 14
                    End With
                Next
            Next

Excel VBA到powerpoint - 幻灯片定位不一致

2 个答案: