Copying Range from Excel to Powerpoint and change alignment with vba - vba

Question

I am trying to copy a range from Excel into PowerPoint using vba.
Copying and Pasting are no Problem, but i can´t get the text in the created PowerPoint table to be aligned right (and vertical Center).
Here is the part how i copy and paste the range:
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
Now I Need something like MyShape.Align = Right (which of course is not working).
Can someone help me with this?
Thx a lot!

Answer 1

Try the following procedure, it works on my Excel file.
You need to have an open PowerPoint, this sub-routine will scan column A in your Excel file (starting from the second row).
It will create a new slide at the end of the open PowerPoint, and will create a Table with the number of rows it found text in your Excel worksheet column A.
At last it will store each Excel's row data in in the new Table.
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