VBA to copy from Excel to PowerPoint (Not 'copy-and-paste')

Question

I'm trying to copy formatted text content from Excel to Powerpoint in VBA--preferably without copy-and-paste, as it just crashes every time I run it (even with multiple DoEvents to slow it down... there are hundreds of cells of heavily formatted text).

That's why I've been trying to get it to work by addressing the cells directly like in the code below.

For i = 1 To WS.Range("A65536").End(xlUp).Row
    If WS.Cells(i, 1) > 0 Then     
        Set newSlide = ActivePresentation.Slides(1).Duplicate
        newSlide.MoveTo (ActivePresentation.Slides.Count)

        With newSlide.Shapes(1).TextFrame.TextRange
            .Text = WS.Cells(i, 1).Value ' Inserts the (non-formatted) text from Excel. Have also tried WS.Cells(i, 1).Text
            .Font.Name = WS.Cells(i, 1).Font.Name ' This works fine
            .Font.Size = WS.Cells(i, 1).Font.Size ' This works fine too

            ' Neither of the below work because there is a mixture of font styled and colours within individual cells
            .Font.FontStyle = WS.Cells(i, 1).Font.FontStyle ' Font Style (Regular, Bold, Italic, Bold Italic)
            .Font.Color = WS.Cells(i, 1).Font.Color ' Font Color
        End With
    End If
Next

It works (very quickly) transferring the cell content, font name, and font size... but NOT for FontStyle (bold, italics, etc.) or FontColor because there is more than one style/color in individual cells.

Is there any way around this? I haven't the foggiest idea what the potential solution (if any) could be, so don't even know where to start looking. Even a push in the right direction would help enormously.

you may have conditional formatting applied to some of the worksheet cells. if you do, you have to use the DisplayFormat property of a range. eg. .Font.Color = WS.Cells(i, 1).DisplayFormat.Font.Color etc..... ( that is because the conditional formatting layers formats into a cell, and the top format is the one that you see.) ....... DisplayFormat is available starting Excel 2010 — jsotola
just replace .Font with .DisplayFormat.Font everywhere in your code ( on excel side of the assignment statement) — jsotola
Thanks for your help jsotola. .DisplayFormat seems to work fine where the ALL the text in a cell is bold... or in italics... or a single color. However, in my spreadsheet, each cell has a mixture of these. For example, in some cells there are some words in bold, and others non-bold... all in the same cell. In other cells, some words are black and some words are red... again, all within the same cell. (Does that make sense? I think maybe my question doesn't make that part very clear.) — ThomasKa
(Using .DisplayFormat with this mixture of styles/colors causes an error: ""Run-time error 438. Object doesn't support this property or method"") — ThomasKa
i just re-read your question. are you saying that part of the text in the cell is one style and the rest of the text in that cell is another style? (meaning colour, font, etc) — jsotola

jsotola jsotola · Accepted Answer · 2017-08-19T05:11:36

here is a proof-of-concept

copying cells from excel into powerPoint

specifics: cells have multiple text formatting per cell

achieved by copying into msWord document and then from msWord into powerPoint

  Sub copyMultipleColorTextPerCell()

    ' this program copies excel cells that contain multiply formatted text in each cell
    ' the text is copiend into an msWord document, because the formatting is retained
    ' and then copied into powerpoint


    ' -------------------------- create powerpoint presentation

    Const ppLayoutBlank = 12

    Dim ppApp As PowerPoint.Application

    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

    If ppApp Is Nothing Then
        Set ppApp = New PowerPoint.Application
    End If

    ppApp.Visible = True

    Dim ppPres As Presentation
    Set ppPres = ppApp.Presentations.Add

    Dim ppSlid As PowerPoint.Slide
    Set ppSlid = ppPres.Slides.Add(1, 1)

    ppSlid.Layout = ppLayoutBlank

    Dim ppShp As PowerPoint.Shape
    Set ppShp = ppPres.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 500, 200)

    Dim ppTxRng As PowerPoint.TextRange
    Set ppTxRng = ppShp.TextFrame.TextRange

    ' ---------------------------------------------------------------

    Dim wdApp As Word.Application                               ' not necessary
    Set wdApp = New Word.Application

    Dim xlRng As Excel.Range
    Set xlRng = Sheets("Sheet1").Range("c6:c7")                 ' this is the range that gets copied into powerPoint, via msWord

    xlRng.Cells(1) = "this is multicolor text"                  ' some multicolour test text, so you don't have to type any
    xlRng.Cells(1).Characters(1, 13).Font.Color = vbGreen
    xlRng.Cells(1).Characters(14, 20).Font.Color = vbRed

    xlRng.Cells(2) = "this is also multicolor"
    xlRng.Cells(2).Characters(1, 12).Font.Color = vbBlue
    xlRng.Cells(2).Characters(13, 20).Font.Color = vbMagenta

    Dim wdDoc As Word.Document
    Set wdDoc = New Word.Document

    Dim wdRng As Word.Range
    Set wdRng = wdDoc.Range

    xlRng.Copy                                    ' copy whole excel range
    wdRng.PasteExcelTable False, False, False     ' paste to msWord doc, because formatting is kept

    Dim wdTb As Table
    Set wdTb = wdDoc.Tables(1)

    ' copy the two cells from msWord table
    wdDoc.Range(start:=wdTb.Cell(1, 1).Range.start, End:=wdTb.Cell(2, 1).Range.End).Copy

    ppTxRng.Paste                                  ' paste into powerPoint text table
    ppTxRng.PasteSpecial ppPasteRTF

    Stop                                           ' admire result ...... LOL

    wdDoc.Close False
    ppPres.Close
    ppApp.Quit

    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set ppSlid = Nothing
    Set ppPres = Nothing
    Set ppApp = Nothing

End Sub

VBA to copy from Excel to PowerPoint (Not 'copy-and-paste')

1 Answers