Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
Old 02-21-2014, 01:32 PM
macropod's Avatar
macropod macropod is offline replace letters by font without losing format Windows 7 32bit replace letters by font without losing format Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

If you're always processing only a single folder, you can replace:
Code:
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
with:


Code:
strFolder = "My file path \*.doc", vbNormal)
where 'My file path ' is your file path, and delete:
Code:
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
You should not make any changes other than the ones I posted - and you should make all of those; otherwise you can't expect the macro to work properly.

Note: Do not put the document holding the macro into the same folder as the files to be processed.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #17  
Old 03-11-2017, 07:25 AM
romanticbiro romanticbiro is offline replace letters by font without losing format Windows 7 32bit replace letters by font without losing format Office 2003
Advanced Beginner
replace letters by font without losing format
 
Join Date: Feb 2014
Posts: 42
romanticbiro is on a distinguished road
Default

hello dears

whin i run this macro i got
Run-time error '5624.

code
----

Code:
Sub demo()
Application.ScreenUpdating = True
Dim strFolder As String, strFile As String, wdDoc As Document
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt

' modify code to make .xls as relative path
Dim My_Path As String
My_Path = Applicatio
StrWkBkNm = My_path & "\table.xls"
StrWkSht = "list"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
'Get the folder to process
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  If xlApp Is Nothing Then
    MsgBox "Can't start Excel.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Excel.
  bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
  'Hide our Excel session
  If bStrt = True Then .Visible = False
  For Each xlWkBk In .Workbooks
    If xlWkBk.FullName = StrWkBkNm Then ' It's open
      Set xlWkBk = xlWkBk
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrWkBkNm) = True Then
      ' Report and exit if true
      MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
    If xlWkBk Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  ' Process the workbook.
  With xlWkBk.Worksheets(StrWkSht)
    ' Find the last-used row in column A.
    ' Add 1 to get the next row for data-entry.
    iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
    ' Output the captured data.
    For i = 1 To iDataRow
      ' Skip over empty fields to preserve the underlying cell contents.
      If Trim(.Range("A" & i)) <> vbNullString Then
        xlFList = xlFList & "|" & Trim(.Range("A" & i))
        xlRList = xlRList & "|" & Trim(.Range("B" & i))
      End If
    Next
  End With
  If bFound = False Then xlWkBk.Close False
  If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each document in the folder
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  'Process each word from the F/R List
  For i = 1 To UBound(Split(xlFList, "|"))
    With wdDoc.Range
      With .Find
.ClearFormatting
        .Replacement.ClearFormatting
' .MatchWholeWord = True
        .MatchCase = True
        .Wrap = wdFindStop
         .Font.Name = "tahoma"
        .Text = Split(xlFList, "|")(i)
        .Replacement.Font.Name = "black br"
        .Replacement.Text = Split(xlRList, "|")(i)

' debugger show this line 
        .Execute Replace:=wdReplaceAll
      End With
    End With
  Next
  'Close the document
  wdDoc.Close SaveChanges:=True
MsgBox "document saved"
  'Get the next document
  strFile = Dir()
Wend
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
 
End Function
Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function
thanks

Last edited by macropod; 03-12-2017 at 06:12 AM. Reason: Added code tags
Reply With Quote
  #18  
Old 03-12-2017, 06:18 AM
macropod's Avatar
macropod macropod is offline replace letters by font without losing format Windows 7 64bit replace letters by font without losing format Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

You have a bleedingly obvious error with:
My_Path = Applicatio

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #19  
Old 03-12-2017, 07:03 AM
romanticbiro romanticbiro is offline replace letters by font without losing format Windows 7 32bit replace letters by font without losing format Office 2003
Advanced Beginner
replace letters by font without losing format
 
Join Date: Feb 2014
Posts: 42
romanticbiro is on a distinguished road
Question runtime errowr


hello macropod

sorry i just was using basic text format,

when i run this macro i got
Run-time error '5624.
in below code i marked the line which make this, but i not able to fix it so hope you will help me.

Code:
Sub Demo()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long, Rslt

'Relative path
Dim My_Path As String
My_Path = Application.ActiveDocument.Path
StrWkBkNm = My_Path & "\Table.xls"
StrWkSht = "list"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
'Get the folder to process
 strFolder = GetFolder
 If strFolder = "" Then Exit Sub
 strFile = Dir(strFolder & "\*.doc", vbNormal)

' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  If xlApp Is Nothing Then
    MsgBox "Can't start Excel.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Excel.
  bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
  'Hide our Excel session
  If bStrt = True Then .Visible = False
  For Each xlWkBk In .Workbooks
    If xlWkBk.FullName = StrWkBkNm Then ' It's open
      Set xlWkBk = xlWkBk
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrWkBkNm) = True Then
      ' Report and exit if true
      MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
    If xlWkBk Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  ' Process the workbook.
  With xlWkBk.Worksheets(StrWkSht)
    ' Find the last-used row in column A.
    ' Add 1 to get the next row for data-entry.
    iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
    ' Output the captured data.
    For i = 1 To iDataRow
      ' Skip over empty fields to preserve the underlying cell contents.
      If Trim(.Range("A" & i)) <> vbNullString Then
        xlFList = xlFList & "|" & Trim(.Range("A" & i))
        xlRList = xlRList & "|" & Trim(.Range("B" & i))
      End If
    Next
  End With
  If bFound = False Then xlWkBk.Close False
  If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each document in the folder
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  'Process each word from the F/R List
  For i = 1 To UBound(Split(xlFList, "|"))
    With wdDoc.Range
      With .Find
.ClearFormatting
        
        .Replacement.ClearFormatting

' .MatchWholeWord = True
        .MatchCase = True
        .Wrap = wdFindStop
        'Set font name
         .Font.Name = "Tahoma"
        .Text = Split(xlFList, "|")(i)
               .Replacement.Font.Name = "Times new roman"
         .Replacement.Text = Split(xlRList, "|")(i)
' Debugger runtime errowr in below line: '        
.Execute Replace:=wdReplaceAll
      End With
    End With
  Next
  'Close the document
  wdDoc.Close SaveChanges:=True
 MsgBox "document saved"
  'Get the next document
  strFile = Dir()
Wend
Application.ScreenUpdating = False
' MsgBox "font conversion done"
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
 
End Function
Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function
Reply With Quote
  #20  
Old 03-13-2017, 01:24 AM
macropod's Avatar
macropod macropod is offline replace letters by font without losing format Windows 7 64bit replace letters by font without losing format Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

On which like are you getting the error? Have you checked the contents of whatever variables are in use at that point?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #21  
Old 03-13-2017, 04:45 AM
romanticbiro romanticbiro is offline replace letters by font without losing format Windows 7 32bit replace letters by font without losing format Office 2003
Advanced Beginner
replace letters by font without losing format
 
Join Date: Feb 2014
Posts: 42
romanticbiro is on a distinguished road
Default

dear macropod

i have excel list contains all letters and its replacement
the errowr in this line
.Execute Replace:=wdReplaceAll

and notice that the document all letters and font not change which means that errowr before find and replacement excute
any ideas will be great
thanks
Reply With Quote
  #22  
Old 03-13-2017, 05:31 AM
macropod's Avatar
macropod macropod is offline replace letters by font without losing format Windows 7 64bit replace letters by font without losing format Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

What is the 'Find' text and 'Replace' text when the error occurs?
And, since you are specifying the Find and Replace fonts, your Find/Replace code should include the line:
.Format = True

You should also replace:
.Wrap = wdFindStop
with:
.Wrap = wdFindContinue
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #23  
Old 03-13-2017, 06:41 AM
romanticbiro romanticbiro is offline replace letters by font without losing format Windows 7 32bit replace letters by font without losing format Office 2003
Advanced Beginner
replace letters by font without losing format
 
Join Date: Feb 2014
Posts: 42
romanticbiro is on a distinguished road
Default

dear macropod

the senario, that in excel file A: find B: replace
macro run once open .doc file errowr occurs
curser in .doc file not highlite any text

i tried your suggested code with and without .clearFormatting

am i need to run it in office 2010 or higher?

Code:
 
   With wdDoc.Range
      With .Find
.ClearFormatting
.format = true        
        .Replacement.ClearFormatting
.format = true
        .MatchCase = True
        .Wrap = wdFindContinue
        'Set font name
         .Font.Name = "Tahoma"
        .Text = Split(xlFList, "|")(i)
               .Replacement.Font.Name = "Times new roman"
         .Replacement.Text = Split(xlRList, "|")(i)
' Debugger runtime errowr in below line: '        
.Execute Replace:=wdReplaceAll
      End With
    End With


thanks very much
Reply With Quote
  #24  
Old 03-13-2017, 02:33 PM
macropod's Avatar
macropod macropod is offline replace letters by font without losing format Windows 7 64bit replace letters by font without losing format Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Quote:
Originally Posted by romanticbiro View Post
the senario, that in excel file A: find B: replace
I am quite aware of that, but it doesn't answer my question. What do Split(xlFList, "|")(i) and Split(xlRList, "|")(i) show when you move the mouse over them when the error occurs?
Quote:
Originally Posted by romanticbiro View Post
am i need to run it in office 2010 or higher?
No. Furthermore, most people have no problems at all using the code...
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #25  
Old 03-13-2017, 04:01 PM
romanticbiro romanticbiro is offline replace letters by font without losing format Windows 7 32bit replace letters by font without losing format Office 2003
Advanced Beginner
replace letters by font without losing format
 
Join Date: Feb 2014
Posts: 42
romanticbiro is on a distinguished road
Default

unfortiontly i use screenreader so we've some issues in debugging
i never use mouse
so, could u run it and see?
am so sorry for this request
Reply With Quote
  #26  
Old 03-13-2017, 04:05 PM
macropod's Avatar
macropod macropod is offline replace letters by font without losing format Windows 7 64bit replace letters by font without losing format Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Since I have neither your Excel workbook nor any of the content you're trying to process, it would be futile for me to run the macro.

Besides which, I have told you what changes you should make to the code and you keep suggesting other changes - without any understanding of their effect. Everything would probably work just fine if you stopped messing with the code...
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #27  
Old 03-13-2017, 04:14 PM
romanticbiro romanticbiro is offline replace letters by font without losing format Windows 7 32bit replace letters by font without losing format Office 2003
Advanced Beginner
replace letters by font without losing format
 
Join Date: Feb 2014
Posts: 42
romanticbiro is on a distinguished road
Default


Quote:
Originally Posted by macropod View Post
Since I have neither your Excel workbook nor any of the content you're trying to process, it would be futile for me to run the macro.
nvm dear, will upload them for u
thanks very much
Reply With Quote
  #28  
Old 03-13-2017, 04:49 PM
romanticbiro romanticbiro is offline replace letters by font without losing format Windows 7 32bit replace letters by font without losing format Office 2003
Advanced Beginner
replace letters by font without losing format
 
Join Date: Feb 2014
Posts: 42
romanticbiro is on a distinguished road
Arrow attached files


evening dear

here attached files for macro and test document also sample for excel list.
am really thanks very much for your time and effort with me.


Attached Files
File Type: xls FrList.xls (13.5 KB, 7 views)
File Type: doc sample.doc (49.5 KB, 7 views)
File Type: doc t1.doc (23.5 KB, 7 views)
Reply With Quote
  #29  
Old 03-14-2017, 04:12 AM
romanticbiro romanticbiro is offline replace letters by font without losing format Windows 7 32bit replace letters by font without losing format Office 2003
Advanced Beginner
replace letters by font without losing format
 
Join Date: Feb 2014
Posts: 42
romanticbiro is on a distinguished road
Default

dear macropod

the code in attached sample
run normally without issues after i reinstall office
but if set font name and format = true
it do nothing
but work perfect if delete font name and formate true
so do you think that wrd 2003 not support font name in find and replace?

thanks
Reply With Quote
  #30  
Old 03-14-2017, 08:32 PM
macropod's Avatar
macropod macropod is offline replace letters by font without losing format Windows 7 64bit replace letters by font without losing format Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

I get no errors with the code in your attachment. That said it also doesn't work, because you need to use .Font.NameAscii instead of .Font.Name. Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean
Dim xlFList As String, xlRList As String, i As Long
StrWkBkNm = Application.ActiveDocument.Path & "\FrTable.xls"
StrWkSht = "list"
If Dir(StrWkBkNm, vbNormal) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
'Get the folder to process
 strFolder = GetFolder
 If strFolder = "" Then Exit Sub
 strFile = Dir(strFolder & "\*.doc", vbNormal)
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  If xlApp Is Nothing Then
    MsgBox "Can't start Excel.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Excel.
  bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
  'Hide our Excel session
  If bStrt = True Then .Visible = False
  For Each xlWkBk In .Workbooks
    If xlWkBk.FullName = StrWkBkNm Then ' It's open
      Set xlWkBk = xlWkBk
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrWkBkNm) = True Then
      ' Report and exit if true
      MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
    If xlWkBk Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  ' Process the workbook.
  With xlWkBk.Worksheets(StrWkSht)
    ' Find the last-used row in column A.
    ' Add 1 to get the next row for data-entry.
    iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
    ' Output the captured data.
    For i = 1 To iDataRow
      ' Skip over empty fields to preserve the underlying cell contents.
      If Trim(.Range("A" & i)) <> vbNullString Then
        xlFList = xlFList & "|" & Trim(.Range("A" & i))
        xlRList = xlRList & "|" & Trim(.Range("B" & i))
      End If
    Next
  End With
  If bFound = False Then xlWkBk.Close False
  If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each document in the folder
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  'Process each word from the F/R List
  For i = 1 To UBound(Split(xlFList, "|"))
    MsgBox Split(xlFList, "|")(i) & vbTab & Split(xlRList, "|")(i)
    With wdDoc.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = True
        .Forward = True
        .MatchCase = True
        .MatchWholeWord = False
        .Wrap = wdFindContinue
        .Font.NameAscii = "Tahoma"
        .Replacement.Font.NameAscii = "Times New Roman"
        .Text = Split(xlFList, "|")(i)
        .Replacement.Text = Split(xlRList, "|")(i)
        .Execute Replace:=wdReplaceAll
        If .Found Then MsgBox "!"
      End With
    End With
  Next
  'Close the document
  wdDoc.Close SaveChanges:=True
  'Get the next document
  strFile = Dir()
Wend
Application.ScreenUpdating = False
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro to replace digits with letters Bananabean Word VBA 6 09-14-2013 09:28 PM
replace letters by font without losing format How to replace all font occurencies by another (e.g. Arial-->Courier) pstein Word 1 04-30-2013 05:58 AM
replace letters by font without losing format Find and Replace maintain format winningson Word 3 01-19-2013 05:38 AM
replace letters by font without losing format Format Font herbhh Word 10 05-23-2011 08:29 AM
How do I import text columns with specified spacing between words w/o losing format? Fucius Word 0 08-09-2010 06:23 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 05:05 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft