How to find & replace Webdings and Wingdings in a doc file.

From Word

Tools->macro->record the macro

when you've finished, please Alt-F11 to see code

It does not work sorry.
I need a vb script

The problem is to find and replace or delete uncommon symbols used with Webdings or Windings.

Do you want to replace entire sentences with webding font or any stary words here and there. As for replacing, do you want to replace charector/word/sentence?

any stroy words here and there. My documents contains lot of wingding symbols which are to be eliminated from the documents.

As a Word macro, you have one of two choices:

    Sub ChangeFont1()
       
        Dim oDoc As Word.Document
        Dim oChar
       
        Set oDoc = Application.ActiveDocument
       
        For Each oChar In oDoc.Characters
           
            If oChar.Font.Name = "Wingdings" or oChar.Font.Name = "Webdings" Then oChar.Font.Name = "Arial"
           
        Next oChar
       
    End Sub

or, option 2; change all fonts that are not Arial to Arial

    Sub ChangeFont2()
       
        Dim oDoc As Word.Document
        Dim oChar
       
        Set oDoc = Application.ActiveDocument
       
        For Each oChar In oDoc.Characters
           
            If oChar.Font.Name <> "Arial" Then oChar.Font.Name = "Arial"
           
        Next oChar
       
    End Sub


The above will word for the current (active) Word document.  If you want to run on another document, you can use:

        Set oDoc = Application.Documents.Open("x:\mypath\mydoc.doc")


If you want to run outside of Word, you must use:

        Set oApp = CreateObject("Word.Application")
        Set oDoc = oApp.Documents.Open("x:\mypath\mydoc.doc")


HTH

J.

If you just want to get rid of all Windings characters, use:

    Sub DeleteWingdings()
       
        Dim oDoc As Word.Document
        Dim oChar
       
        Set oDoc = Application.ActiveDocument
       
        For Each oChar In oDoc.Characters
           
            If oChar.Font.Name = "Wingdings" Then oChar.Text = ""
           
        Next oChar
       
    End Sub


You can adapt to other fonts, too, by changing the code to the following:

            If oChar.Font.Name = "Wingdings" or oChar.Font.Name = "Webdings" or oChart.Font.Name = "thisfontidontlike" Then oChar.Text = "" 


HTH

J.

Thanks for advise but it does nothing.

It does nothing?

It works for me.

Are you sure the characters you want to remove are in the font 'Wingdings'?  Or are they just garbage characters?

I have inserted these characters from insert symbol menu by selecting Wingdings, Webdings, Wingdings 1.
I have tried so many times with your macro but it does nothing. Is there any other specific option in find and replace is to be selected?
Thanks
S

>> I have inserted these characters from insert symbol menu

There is your problem.  When you use Inser -> Symbol, the character that is inserted does not have a different font (nice one Microsoft); it still thinks the character is in the same font as the rest of the text.  As there is no VBA.Collection for symbols, this makes it very difficult to remove all at the same time.

J.

Getting Runtime error code  4605 at
 'Set dlg = Dialogs(wdDialogInsertSymbol)'

I took the code straight from Microsoft and it worked fine for me.  What version of Word are you using and are you using the code inside Word VBA?  If you are using Excel's VBA for this, it will not work without an overhaul...

J.

I m using word 2003

J.
I have found one macro which works.
Sub FindDeltaSymbols()
    'Call the main "FindSymbols" macro (below),
    'and tell it what character code  and font to search for
    Call FindSymbols(FindChar:=ChrW(-3996), FindFont:="Wingdings")
End Sub


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

Sub  FindSymbols(FindChar As String, FindFont As String)

Dim FoundFont As String, OriginalRange As Range, strFound As Boolean
Application.ScreenUpdating = False

'set range to return to in case symbol not found
Set OriginalRange = Selection.Range

strFound = False
Sub FindSymbols(FindChar As String, FindFont As String)

Dim FoundFont As String, OriginalRange As Range, strFound As Boolean
Application.ScreenUpdating = False

'set range to return to in case symbol not found
Set OriginalRange = Selection.Range

strFound = False
With Selection.Find
    .ClearFormatting
    .Text = FindChar
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
End With
End Sub
The problem is I need to make seperate macro for each wingding.
Is there any way to automate this by using wild card search or other way.
Thanks

The macro I found worked just right for me in both 2000 and 2003.  It removed all WIngdings fonts and all inserted symbols.

I don't know what happened to it when you tried it -- I can't find a write up of Error 4605, anywhere...

J.

You amy be right. But it does not work with me even in word 95, 2000, xp or 2003.
I found the following macro working perfectly but need automation:
Sub GetCharNoAndFont()
With Dialogs(wdDialogInsertSymbol)
    Debug.Print "Font: " & .Font
    Debug.Print "Char number " & .CharNum
End With
End Sub
Sub ReplaceAllDeltaSymbolsWithBetaSymbols()
    'Call the main "ReplaceAllSymbols" macro (below),
    'and tell it which character code  and font to search for, and which to replace with
    Call ReplaceAllSymbols(FindChar:=ChrW(-3904), FindFont:="Webdings")
End Sub
Sub ReplaceAllSymbols(FindChar As String, FindFont As String)
With Selection.Find
    .ClearFormatting
    .Text = FindChar
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
  End With
End Sub
Is there any way to loop the character find through variable?
Or any other way to automate this macro.