ExcelのVBAをパワーポイントに合わせる - スライドの位置が矛盾する

Question

私はVBAの新機能で、他の既存のスクリプトを適用して学習しようとしています。

以下のスクリプト私は自分の要件に適応することができましたが、スライドの配置を除いて、各スライドのパワーポイント内の激しく異なる場所に範囲を配置するようです。私はオブジェクトをスライドの左手側と上端から設定された距離から完全に揃えるように設定しようとしています。

これを引き起こすようなコードには明らかに間違った何かがありますか？

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

また、私は、しかし、これは仕事を得ることができない、にコピーされている範囲内のテキストのフォントとサイズを設定するためのさまざまな方法を試してみました。たとえば、認識されなかった "myPresentation.PageSetup"コマンドの下にコードを追加しようとしました。

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

右方向のどのポインタがそうよう

Answer 1

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 

Answer 2

はそれを試して理解されるであろう： の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