This is not a PowerPoint forum but perhaps:
Code:
Sub FormatByExcel()
'Code by Gregory K. Maxey
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim bStartApp As Boolean
Dim varArray As Variant
Dim FD As FileDialog
Dim strSource As String
Dim lngIndex As Long
Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim oFoundTxt As TextRange
'**** This is the basically the same as Doug's original code
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
.Title = "Select the workbook that contains the terms to be italicized"
.Filters.Clear
.Filters.Add "Excel Workbooks", "*.xlsx"
.AllowMultiSelect = False
If .Show = -1 Then
strSource = .SelectedItems(1)
Else
MsgBox "You did not select the workbook that contains the data"
Exit Sub
End If
End With
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
bStartApp = True
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlbook = xlapp.Workbooks.Open(strSource)
Set xlsheet = xlbook.Worksheets(1)
varArray = xlsheet.Range("A1").CurrentRegion.Value
If bStartApp = True Then xlapp.Quit
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
'****
'#### Since I don't have your Excel file, this is simply for testing
ReDim varArray(1)
varArray(0) = "Apples"
varArray(1) = "Oranges"
'####
'@@@@ I am far from a PowerPoint expert, but a causal Google search turned up something that I could adapt to suit.
For lngIndex = 0 To UBound(varArray)
'Loop through each slide in presentation
For Each oSld In ActivePresentation.Slides
'Loop through each shape on slide
For Each oShp In oSld.Shapes
'Is there text in the shape?
If oShp.HasTextFrame Then
Set oTxtRng = oShp.TextFrame.TextRange
Set oFoundTxt = oTxtRng.Find(FindWhat:=varArray(lngIndex))
Do While Not (oFoundTxt Is Nothing)
With oFoundTxt
.Font.Italic = True
Set oFoundTxt = oTxtRng.Find(FindWhat:=varArray(lngIndex), After:=.Start + .Length - 1)
End With
Loop
End If
Next oShp
Next oSld
Next lngIndex
lbl_Exit:
Exit Sub
End Sub