Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

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

Posted on 2004-10-22
19
Medium Priority
?
1,229 Views
Last Modified: 2012-05-05
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
0
Comment
Question by:micazone
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
19 Comments
 
LVL 26

Expert Comment

by:EDDYKT
ID: 12381784
From Word

Tools->macro->record the macro

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

Author Comment

by:micazone
ID: 12386941
It does not work sorry.
I need a vb script
0
 

Author Comment

by:micazone
ID: 12387277
The problem is to find and replace or delete uncommon symbols used with Webdings or Windings.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12392596
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
 

Author Comment

by:micazone
ID: 12394055
any stroy words here and there. My documents contains lot of wingding symbols which are to be eliminated from the documents.
0
 
LVL 16

Expert Comment

by:jimbobmcgee
ID: 12396459
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
 
LVL 16

Expert Comment

by:jimbobmcgee
ID: 12396469
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
 

Author Comment

by:micazone
ID: 12398288
Thanks for advise but it does nothing.
0
 
LVL 16

Expert Comment

by:jimbobmcgee
ID: 12410367
It does nothing?

It works for me.
0
 
LVL 16

Expert Comment

by:jimbobmcgee
ID: 12410373
Are you sure the characters you want to remove are in the font 'Wingdings'?  Or are they just garbage characters?
0
 

Author Comment

by:micazone
ID: 12411825
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
 
LVL 16

Expert Comment

by:jimbobmcgee
ID: 12420040
>> 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
 
LVL 16

Accepted Solution

by:
jimbobmcgee earned 750 total points
ID: 12420066
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
 

Author Comment

by:micazone
ID: 12422178
Getting Runtime error code  4605 at
 'Set dlg = Dialogs(wdDialogInsertSymbol)'

0
 
LVL 16

Expert Comment

by:jimbobmcgee
ID: 12431679
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
 

Author Comment

by:micazone
ID: 12433007
I m using word 2003
0
 

Author Comment

by:micazone
ID: 12444018
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
 
LVL 16

Expert Comment

by:jimbobmcgee
ID: 12459485
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
 

Author Comment

by:micazone
ID: 12463046
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

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

618 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question