複数のExcelテーブルを別々のPowerPointスライドに配置する

Question

ExcelからPowerpointまでの範囲をテーブルとして貼り付けています。

問題は、最初のテーブルを貼り付けると、ポジショニングが正常に機能しますが（.Topと.Left）、最初のテーブルの後に貼り付けられたテーブルは、最初のテーブルから相対的に配置されます。

.Topは、テーブルの左上隅と最初のテーブルの位置の上端との間の距離になります（スライドの上辺ではありません！）。同じことが起こります。左（テーブルの左上隅から最初のテーブルの左端までの距離を表します）。

コードは以下の通りです：

Sub ExportaraPowerPoint() 

Dim pptApp As PowerPoint.Application 
Dim pptPres As PowerPoint.Presentation 
Dim pptSlide As PowerPoint.Slide 
Dim pptShape As PowerPoint.Shape 
Dim excelTable As Excel.Range 
Dim SlideTitle As String 
Dim SlideText As String 
Dim SlideObject As Object 
Dim pptTextbox As PowerPoint.Shape 
Dim SlideNumber As String 
Dim xlTable As PowerPoint.Shape 

'Check is PPT is open and create if not 
On Error Resume Next 
Set pptApp = GetObject("", "PowerPoint.Application") 
Err.Clear 
If pptApp Is Nothing Then Set pptApp = CreateObject(class:="PowerPoint.Application") 
pptApp.Visible = True 
pptApp.Activate 

'Add presentation 
Set pptPres = pptApp.Presentations.Add 
pptPres.PageSetup.SlideSize = ppSlideSizeOnScreen 
pptPres.ApplyTemplate "c:\Program Files\Microsoft Office\Templates\1033\Blank.potx" 

'Assing Tables 
Set excelTable1 = Worksheets("TDSACI").Range("N246:U259") 
Set excelTable2 = Worksheets("TDCSD").Range("N215:U223") 

'Slide 1: 
Set pptSlide = pptPres.Slides.Add(1, ppLayoutTitleOnly) 
excelTable1.Copy 
pptSlide.Shapes.PasteSpecial (ppPasteDefault) 
pptSlide.Shapes(2).Width = 670.4 
pptSlide.Shapes(2).Height = 292 
pptSlide.Shapes(2).Left = 24.4 
pptSlide.Shapes(2).Top = 90.4 

'Slide 2: 
Set pptSlide = pptPres.Slides.Add(2, ppLayoutTitleOnly) 
excelTable2.Copy 
pptSlide.Shapes.PasteSpecial (ppPasteDefault) 
pptSlide.Shapes(2).Width = 670.4 
pptSlide.Shapes(2).Height = 292 
pptSlide.Shapes(2).Left = 24.4 
pptSlide.Shapes(2).Top = 90.4 

私は、テーブルには、常に形状指標番号2であるので、それは問題ではないことを知っています。

数字によると、両方のテーブルの位置は同じである必要があります。

Answer 1

好奇心。 On Error Resume Nextをコメントアウトする場合、VBEがに設定されていることを確認してください。で、最初のSlide 2行に改行を入れると、 .PasteSpecial行はエラーを生成しません。私はこれは、PowerPointがスライド2が表示されていないと訴えているためだと思います。そのため、オブジェクトがスライドに貼り付けられているように見えても、貼り付け方法が乱れてしまいます。私はGotoSlide方法追加することによって、私のデモデッキ（パワーポイント2016）の上にそれを修正：パワーポイントビューを操作

'Slide 2: 
Set pptSlide = pptPres.Slides.Add(2, ppLayoutTitleOnly) 
excelTable2.Copy 
pptApp.ActiveWindow.View.GotoSlide 2 
pptSlide.Shapes.PasteSpecial (ppPasteDefault) 
pptSlide.Shapes(2).Width = 670.4 
pptSlide.Shapes(2).Height = 292 
pptSlide.Shapes(2).Left = 24.4 
pptSlide.Shapes(2).Top = 90.4 

ので私はコードがパワーポイントVBEで実行されている場合は、スライドにオブジェクトを貼り付ける必要はありませんこの場合、何がうまくいかないかはわかりません。

Answer 2

'Assing tablesから下部分を交換するには、次のコードは、より良い（よりスケーラブル）であるかもしれないあなたが2つの以上の範囲に対処するために探しているなら...

'Assing Tables 

Dim excelTables(1) As Range 

Set excelTables(0) = Worksheets("TDSACI").Range("N246:U259") 
Set excelTables(1) = Worksheets("TDCSD").Range("N215:U223") 

For Each myTable In excelTables 

    myTable.Copy 

    With pptPres.Slides.Add(pptPres.Slides.Count + 1, ppLayoutTitleOnly) 
     .Select 
     With .Shapes.PasteSpecial(ppPasteDefault) 
      .Width = 670.4 
      .Height = 292 
      .Left = 24.4 
      .Top = 90.4 
     End With 
    End With 

Next