![]() |
|
#1
|
|||
|
|||
![]() It was an array dimension issue. Try: 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 = 1 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, 1)) Do While Not (oFoundTxt Is Nothing) With oFoundTxt .Font.Italic = True Set oFoundTxt = oTxtRng.Find(FindWhat:=varArray(lngIndex, 1), After:=.Start + .Length - 1) End With Loop End If Next oShp Next oSld Next lngIndex lbl_Exit: Exit Sub End Sub |
#2
|
|||
|
|||
![]()
Dear Greg Maxey
![]() It works perfectly Thanks so much You saved my time Thank you, That’s very kind of you Thanks for your time and consideration I can't thank you enough I wholeheartedly appreciate everything you’ve done for me Thank you again Best wishes ![]() |
![]() |
Tags |
find & replace, power automate, wordvba |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
laith93 | Word VBA | 2 | 03-09-2023 11:51 PM |
![]() |
SamDsouza | Word VBA | 3 | 03-12-2020 04:49 AM |
How I convert formua into VBA code I need help | Moot70 | Excel Programming | 1 | 10-27-2019 06:15 AM |
![]() |
SidCharming | Word VBA | 2 | 08-09-2018 08:21 AM |
![]() |
Lady_Laughsalot | Word VBA | 4 | 04-18-2018 12:32 AM |