font size while copying excel range to powerpoint

Question

I am trying to copy a range from Excel to Powerpoint using VBA. Once I run the VBA macro. The range is pasted in powerpoint of font size =6. I want the font size to be 9 when pasted into powerpoint.

This is the code :

Sub ExcelRangeToPowerPoint()

Dim rng As Excel.Range
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape

'Columns("M:M").Select
'Columns("M:M").EntireColumn.AutoFit
'Copy Range from Excel
  Set rng = ThisWorkbook.ActiveSheet.Range("C8:M56")

'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 open PowerPoint
      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(Class:="PowerPoint.Application")

    '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.Visible = True
  PowerPointApp.Activate

'Create a New Presentation
  Set myPresentation = PowerPointApp.Presentations.Add

'Add a slide to the Presentation
  Set mySlide = myPresentation.Slides.Add(1, ppLayoutTitleOnly)

'Copy Excel Range
  rng.Copy

'Paste to PowerPoint and position
  mySlide.Shapes.Paste

   'Special DataType:=ppPasteEnhancedMetafile


  Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)


      myShapeRange.Left = 25
      'myShapeRange.Top = 27
      myShapeRange.Width = myPresentation.PageSetup.SlideWidth - 30
      myShapeRange.Height = myPresentation.PageSetup.SlideHeight - 120

    'Set position:
    'PowerPointApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
    'PowerPointApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue


'Clear The Clipboard
  Application.CutCopyMode = False

End Sub

Jeanno Jeanno · Accepted Answer · 2015-01-27T08:01:18

Instead of copying the Excel range and pasting into PowerPoint (which will generate a native PowerPoint table), modify your original code to include the following. This will simultaneously populate your table in PowerPoint and change the font size.

Dim tblShape As PowerPoint.Shape

    With mySlide.Shapes
        Set tblShape = .AddTable(NumRows:=rng.Rows.Count, NumColumns:=rng.Columns.Count, Left:=30, _
                                    Top:=110, Width:=660, Height:=320)
    End With
    Dim i As Long, j As Long, k As Long, l As Long
    k = 1 ' PowerPoint Table row
    For i = rng.Row To rng.Row + rng.Rows.Count - 1
        l = 1 'PowerPoint Table column
        For j = rng.Column To rng.Column + rng.Columns.Count - 1
            tblShape.Table.Cell(k, l).Shape.TextFrame.TextRange.Text = ThisWorkbook.ActiveSheet.Cells(i, j).Value
            tblShape.Table.Cell(k, l).Shape.TextFrame.TextRange.Font.Size = 15
            l = l + 1
        Next j
        k = k + 1
    Next i

font size while copying excel range to powerpoint

2 Answers