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

I need to find lot of webdings, wingdings in a doc files and replace them with just one space. Can any expert provide VB script or VB Macro for the same.
Thanks
micazoneAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

EDDYKTCommented:
From Word

Tools->macro->record the macro

when you've finished, please Alt-F11 to see code
0
micazoneAuthor Commented:
It does not work sorry.
I need a vb script
0
micazoneAuthor Commented:
The problem is to find and replace or delete uncommon symbols used with Webdings or Windings.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Shahid ThaikaSole ProprietorCommented:
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?
0
micazoneAuthor Commented:
any stroy words here and there. My documents contains lot of wingding symbols which are to be eliminated from the documents.
0
jimbobmcgeeCommented:
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.
0
jimbobmcgeeCommented:
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.
0
micazoneAuthor Commented:
Thanks for advise but it does nothing.
0
jimbobmcgeeCommented:
It does nothing?

It works for me.
0
jimbobmcgeeCommented:
Are you sure the characters you want to remove are in the font 'Wingdings'?  Or are they just garbage characters?
0
micazoneAuthor Commented:
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
0
jimbobmcgeeCommented:
>> 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.
0
jimbobmcgeeCommented:
OK, I have found a piece of ugly Microsoft-written macro code that converts all Unicode characters to ASCII.  I have adapted this to remove all symbols in the active (the one opened and being edited currently in Word) document:

    Sub DeleteAllSymbols()
       Dim dlg As Object
       Dim NoFC As Integer
       Dim SCP As Integer
       Dim StartRange As Range
       Dim UniCodeNum As Integer
       
       ActiveDocument.Select                   '<--SELECT ENTIRE DOCUMENT
       
       ' Temporarily disable Screen Updating
       Application.ScreenUpdating = False
       ' Temporarily disable Smart Cut & Paste
       If Options.SmartCutPaste = True Then
          SCP = 1
          Options.SmartCutPaste = False
       End If
       ' Temporarily display field text
       If ActiveWindow.View.ShowFieldCodes = False Then
          NoFC = 1
          ActiveWindow.View.ShowFieldCodes = True
       End If
       ' Set StartRange variable to current selection's range
       Set StartRange = Selection.Range
       Selection.Collapse
       ' Select first, then each next character in user-defined selection
       Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend
       While Selection.End <= StartRange.End And _
       ActiveDocument.Content.End > Selection.End
         ' If the character is a space, then move to next character
         Set dlg = Dialogs(wdDialogInsertSymbol)
         UniCodeNum = dlg.charnum
         If UniCodeNum = 32 Then
           Selection.Collapse
           Selection.MoveRight unit:=wdCharacter, Extend:=wdMove
           Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend
         End If
         ' Loop, converting symbol Unicode characters to ASCII characters
         Set dlg = Dialogs(wdDialogInsertSymbol)
         UniCodeNum = dlg.charnum
         While UniCodeNum < 0 And Selection.End <= StartRange.End _
         And ActiveDocument.Content.End > Selection.End
            Selection.Delete
            Selection.InsertAfter ""     '<--REMOVE CHARACTER IF CHAR CODE IS -VE
            Selection.Collapse (wdCollapseEnd)
            Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend
            Set dlg = Dialogs(wdDialogInsertSymbol)
            UniCodeNum = dlg.charnum
         Wend
         Selection.Collapse (wdCollapseEnd)
         Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend
       Wend
       ' Reset Word document settings
       If SCP = 1 Then Options.SmartCutPaste = True
       If NoFC = 1 Then ActiveWindow.View.ShowFieldCodes = False
          Selection.Collapse (wdCollapseStart)
          Selection.MoveLeft unit:=wdCharacter
          Application.ScreenUpdating = True
    End Sub

HTH

J.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
micazoneAuthor Commented:
Getting Runtime error code  4605 at
 'Set dlg = Dialogs(wdDialogInsertSymbol)'

0
jimbobmcgeeCommented:
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.
0
micazoneAuthor Commented:
I m using word 2003
0
micazoneAuthor Commented:
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

0
jimbobmcgeeCommented:
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.
0
micazoneAuthor Commented:
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.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.