VBA Excel以粗体粘贴到PowerPoint

Question

Hi Have built this string

str = ""
str = "Release Date" & str & objWorksheet.Cells(i, 1).Value & Chr(13)
str = "Distributor" & str & objWorksheet.Cells(i, 2).Value & Chr(13)
str = "Genre" & str & objWorksheet.Cells(i, 10).Value & Chr(13)
str = "Starring" & str & objWorksheet.Cells(i, 7).Value & Chr(13) & Chr(13)
str = str & objWorksheet.Cells(i, 14).Value

In Excel and ready to copy it over to a text box in PowerPoint 2010.

The words in "" I would like to be Bold when pasting, with everything else regular.

How do I go about doing that (coding in Excel VBA).

The PowerPoint presentation is created afresh every time so can't have the code in PowerPoint.

Thank you!

---

My Code looks like this: I keep getting MisMatch error 13 when it tries to run BoldSomeWords

Hi David. Just tried this and I'm getting Type Mismatch error. My full code looks like this:

Sub CreateSlides()
'Dim the Excel objects
 Dim objWorkbook As New Excel.Workbook
 Dim objWorksheet As Excel.Worksheet

 'Dim the File Path String
Dim strFilePath As String

'Dim the PowerPoint objects
Dim PPT As Object
Dim pptSlide As PowerPoint.Slide
Dim pptLayout As PowerPoint.CustomLayout
Dim pptNewSlide As PowerPoint.Slide
Dim str As String
Dim Title As String

Set PPT = GetObject(, "PowerPoint.Application")

 PPT.Visible = True

'Get the layout of the first slide and set a CustomLayout object
Set pptLayout = PPT.ActivePresentation.Slides(1).CustomLayout

'Run the OpenFile function to get an Open File dialog box. It returns a String      containing the file and path.
strFilePath = OpenFile()

'Open the Excel file
Set objWorkbook = Excel.Application.Workbooks.Open(strFilePath)

'Grab the first Worksheet in the Workbook
Set objWorksheet = objWorkbook.Worksheets(1)

'Loop through each used row in Column A
For i = 2 To objWorksheet.Range("A65536").End(xlUp).Row

Set PPT = GetObject(, "PowerPoint.Application")

Set pptNewSlide =     PPT.ActivePresentation.Slides.AddSlide(PPT.ActivePresentation.Slides.Count + 1, pptLayout)

 'Get the number of columns in use on the current row
    Dim LastCol As Long
    Dim boldWords As String


    boldWords = "Release Date: ,Distributor: ,Genre: ,Starring: "
    LastCol = objWorksheet.Rows(i).End(xlToRight).Column
    If LastCol = 16384 Then LastCol = 1 'For some reason if only column 1 has data it     returns 16384, so correct it

    'Build a string of all the columns on the row
    str = ""
    str = "Release Date: " & str & objWorksheet.Cells(i, 1).Value & Chr(13) & _
    "Distributor: " & objWorksheet.Cells(i, 2).Value & Chr(13) & _
    "Genre: " & objWorksheet.Cells(i, 10).Value & Chr(13) & _
    "Starring: " & objWorksheet.Cells(i, 7).Value & Chr(13) & Chr(13) & _
    objWorksheet.Cells(i, 14).Value

 sfile = Cells(i, 3) & ".jpg"

Set PPT = GetObject(, "PowerPoint.Application")

spath = "FILEPATHGOESHERE"


'Write the string to the slide
pptNewSlide.Shapes(2).TextFrame.TextRange.Text = objWorksheet.Cells(i, 3).Value 'This     enters the film Title
    PPT.ActivePresentation.Slides(PPT.ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = str

BoldSomeWords PPT.ActivePresentation.Slides(PPT.ActivePresentation.Slides.Count).Shapes(1), str, boldWords

Answer 1

Applying formatting to substrings is not difficult, but it can be cumbersome given the depth of PowerPoint's object model. Here is a simple illustration.

NOTE I modified the string concatenation because it looked incorrect to me (essentially you were duplicating the string within itself, which didn't seem correct).

Sub Main()
'This will be the calling procedure, so it can be the one which
' builds the concatenated string, but also will be where you define
' which parts of this string should be bold
Dim str$
Dim boldWords as String

'Establish a string of words/phrases to bold, to be used later
boldWords = "Release Date,Distributor,Genre,Starring"

'Create your concatenated string
' I modified this because I don't think it was correct
str = ""
str = "Release Date" & str & objWorksheet.Cells(i, 1).Value & Chr(13) & _
    "Distributor" & objWorksheet.Cells(i, 2).Value & Chr(13) & _
    "Genre"  & objWorksheet.Cells(i, 10).Value & Chr(13) & _
    "Starring" & objWorksheet.Cells(i, 7).Value & Chr(13) & Chr(13) & _
    objWorksheet.Cells(i, 14).Value

'Put these words in a shape:
ActivePresentation.Slides(1).Placeholders(1).TextFrame.TextRange.Text = str

'Send your string, the list of bold words, and the shape in to a subroutine
'  that will apply the bold font
BoldSomeWords ActivePresentation.Slides(1).Shapes(1), str, boldWords

That subroutine will then invoke the following sub, which applies formatting bold for particular substrings, given as part of the list assigned in myWords variable, above.

Sub BoldSomeWords(shp As Object, str As String, myWords As String)

    Dim word As Variant
    Dim iStart As Integer, iEnd As Integer

    'Convert the list of words in to an iterable array, and
    ' iterate it.
    For Each word In Split(myWords, ",")
        'Loop just in case there are duplicates, or omit the Do Loop if
        ' that is not a concern.
        Do Until InStr(iEnd + 1, str, word) = 0
            iStart = InStr(iStart + 1, str, word)
            iEnd = iStart + Len(word)
            shp.TextFrame.TextRange.Characters(iStart, Len(word)).Characters.Font.Bold = msoTrue
        Loop
    Next

End Sub

UPDATE FROM COMMENTS

I changed the declaration for shp in the BoldSomeWords routine to generic object instead of Shape . I think there is a conflict between a PowerPoint.Shape and an Excel.Shape , and in the context of your VBE, it assumes to be an Excel.Shape , hence the mismatch.

Either of the following should work, late-binding as generic Object :

BoldSomeWords(shp As Object, str As String, myWords As String)

Or early-binding as a strongly-typed shape:

BoldSomeWords(shp As PowerPoint.Shape, str As String, myWords As String)

A few more things to consider...

Get rid of New keyword in your objWorkbook declaration, it's unnecessary because you're assigning the objWorkbook using the Excel.Application.Workbooks.Open method, so you don't need a New workbook.

Change PPT from generic Object to strongly typed PowerPoint.Application there is no real reason to mix early- and late-binding your objects.

You have three assignment statements Set PPT = GetObject(, "PowerPoint.Application") . Only the first one is needed.

Declare ALL of your variables, sPath, sFile, i... There may be more, if you use Option Explicit that will identify the undeclared variables for you.

There were one or two places where you used the fully qualified PPT.ActivePresentation.Slides(PPT.ActivePresentation.Slides.Count) when you already have a variable pptNewSlide . Use this for brevity's sake, instead, for example in the last two lines, you could change to:

pptNewSlide.Shapes(1).TextFrame.TextRange.Text = str

BoldSomeWords pptNewSlide.Shapes(1), str, boldWords