ExcelからPowerpointに範囲をコピーして、vbaとの配置を変更します。

Question

ExcelからPowerPointに範囲をvbaを使用してコピーしようとしています。 コピー＆ペーストは問題ありませんが、作成されたPowerPointテーブルのテキストを右揃え（垂直中央）にすることはできません。ここで

は私がコピー範囲を貼り付ける方法を一部です：

Dim myWks As Excel.Worksheet 
Dim ppSlide As PowerPoint.Slide 


wksData.Range("A2:A5").Copy 
ppSlide.Shapes.PasteSpecial 
Set MyShape = ppSlide.Shapes(ppSlide.Shapes.Count) 

MyShape.Top = x 
MyShape.Height = y 
MyShape.Width = z 
MyShape.Left = m 

今、私は（動作していないもちろん）MyShape.Align =右のようなものが必要です。 誰かがこれを手伝ってくれますか？

Thx a lot！

Answer 1

次の手順を試してみてください。それは自分のExcelファイルで動作します。 開いているPowerPointが必要です。このサブルーチンは、Excelファイルの列Aを2行目からスキャンします。
開いているPowerPointの最後に新しいスライドを作成し、Excelワークシートの列Aにテキストが含まれている行数のテーブルを作成します。 最後に、各Excelの行データを新しい表。

Sub Export_to_PPT_Table() 

Dim wksData    As Excel.Worksheet 
Dim PPT     As PowerPoint.Application 
Dim ppslide    As PowerPoint.Slide 
Dim ppShape    As PowerPoint.Shape 
Dim ppTable    As PowerPoint.Table 

' in brackets add your worksheet name 
Set wksData = ActiveWorkbook.Worksheets("Sheet2") 
Set PPT = New PowerPoint.Application 
PPT.Visible = True 

'Add a blank slide at the end of an existing PowerPoint 
Set ppslide = PPT.ActivePresentation.Slides.Add(PPT.ActivePresentation.Slides.Count + 1, PowerPoint.PpSlideLayout.ppLayoutBlank) 

Dim Excel_numofRows   As Integer 
ExcelRow = 2 
' loop through your excel file in Column A, and check for last row with existing text inside 
While wksData.Cells(ExcelRow, 1) <> "" 
    Excel_numofRows = ExcelRow 
    ExcelRow = ExcelRow + 1 
Wend 

' create a new Table in the new slide created 
' in brackets is where you play with your table's properties 
Set ppShape = ppslide.Shapes.AddTable(Excel_numofRows, 1, 100, 100, PPT.ActivePresentation.PageSetup.SlideWidth - 300, 150) 
Set ppTable = ppShape.Table 

ExcelRow = 2 
While wksData.Cells(ExcelRow, 1) <> "" 
    With ppTable 
     .Cell(ExcelRow - 1, 1).Shape.TextFrame.TextRange.Text = wksData.Cells(ExcelRow, 1) 
     .Cell(ExcelRow - 1, 1).Shape.TextFrame.TextRange.ParagraphFormat.Alignment = msoTextEffectAlignmentRight 
     .Cell(ExcelRow - 1, 1).Shape.TextFrame.VerticalAnchor = msoAnchorMiddle 
    End With 
    ExcelRow = ExcelRow + 1 
Wend 

End Sub