Solved

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

Posted on 2004-10-22
942 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
Question by:micazone
    19 Comments
     
    LVL 26

    Expert Comment

    by:EDDYKT
    From Word

    Tools->macro->record the macro

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

    Author Comment

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

    Author Comment

    by:micazone
    The problem is to find and replace or delete uncommon symbols used with Webdings or Windings.
    0
     
    LVL 9

    Expert Comment

    by:Shahid Thaika
    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
    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
    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
    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
    Thanks for advise but it does nothing.
    0
     
    LVL 16

    Expert Comment

    by:jimbobmcgee
    It does nothing?

    It works for me.
    0
     
    LVL 16

    Expert Comment

    by:jimbobmcgee
    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
    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
    >> 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:
    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
    Getting Runtime error code  4605 at
     'Set dlg = Dialogs(wdDialogInsertSymbol)'

    0
     
    LVL 16

    Expert Comment

    by:jimbobmcgee
    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
    I m using word 2003
    0
     

    Author Comment

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

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Course: JavaScript Coding - Massive 12-Part Bundle

    Regardless of your programming skill level, you'll go from basics to advanced concepts in a vast array of JavaScript subjects including Sammy.js, Agility.js, Ember.js, Node.js, jQuery, AJAX, Extjs, AngularJS, Knockout.js, and JSON.

    When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
    Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
    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…

    846 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

    Need Help in Real-Time?

    Connect with top rated Experts

    12 Experts available now in Live!

    Get 1:1 Help Now