Visual Basic (VB and VBA)

Copyright 1999-2001 Christopher Greaves. All rights reserved.
Home Page and email to [email protected]
If in doubt, record a macro and inspect the entrails!

 

 

Please read the DISCLAIMER.

Here is an INDEX to all the procedures.

You will probably need one copy of my GLOBAL DECLARATIONS.



Public Function intRemoveText(strFirst As String, strLast As String, intDelta As Integer, intFuzz As Integer)
' Procedure :   intRemoveText
' Description:  Locate and delete strings bounded by strFirst and strLast
' Copyright: Chris Greaves Inc.
' Inputs:       String at start of block.
'               String at end of block.
'               Nominal distance between the start and end strings.
'               Fuzz tolerance expressed as an integer percentage.
' Returns:      the number of matches found.
' Assumes:      None.
' Side Effects:
' Tested:       By the calls shown below.
Const strcBkMk As String = "intRemoveText"
Dim lngStart As Long
Dim lngEnd As Long
Dim intDiff As Integer
intRemoveText = 0
WordBasic.EditFind Find:=strFirst, Direction:=0, WholeWord:=0, Format:=0
WordBasic.EditBookmark Add:=1, Name:=strcBkMk
While WordBasic.EditFindFound()
    lngStart = WordBasic.GetSelStartPos()
    WordBasic.EditBookmark Add:=1, Name:=strcBkMk
    WordBasic.CharRight
    WordBasic.EditFind Find:=strLast
    lngEnd = WordBasic.GetSelEndPos()
    intDiff = lngEnd - lngStart
    If (Abs(intDelta - intDiff)) / intDelta < (intFuzz / 100) Then
        intRemoveText = intRemoveText + 1
        WordBasic.SetSelRange lngStart, lngEnd
        WordBasic.WW6_EditClear
        WordBasic.CharRight
    Else
        WordBasic.EditBookmark GoTo:=1, Name:=strcBkMk
        WordBasic.EditBookmark Delete:=1, Name:=strcBkMk
        WordBasic.CharLeft
        WordBasic.CharRight
    End If
    WordBasic.EditFind Find:=strFirst, Direction:=0, WholeWord:=0, Format:=0
Wend
'Sub TESTintRemoveText() ' This test runs on the text shown below.
'MsgBox intRemoveText("This", "modules", 75, 10) ' Estimate 75 chars per line, 10% tolerance.
'End Sub
End Function

We all knew nothing when we started …
Home Page and Contact Information
Send email to [email protected].
This page was last updated Thursday, November 15, 2001

 

 

Hosted by www.Geocities.ws

1

Visual Basic (VB and VBA)

Copyright 1999-2001 Christopher Greaves. All rights reserved.
Home Page and email to [email protected]
If in doubt, record a macro and inspect the entrails!

 

 

Please read the DISCLAIMER.

Here is an INDEX to all the procedures.

You will probably need one copy of my GLOBAL DECLARATIONS.

Public Function intRemoveText(strFirst As String, strLast As String, intDelta As Integer, intFuzz As Integer)
' Procedure :   intRemoveText
' Description:  Locate and delete strings bounded by strFirst and strLast
' Copyright: Chris Greaves Inc.
' Inputs:       String at start of block.
'               String at end of block.
'               Nominal distance between the start and end strings.
'               Fuzz tolerance expressed as an integer percentage.
' Returns:      the number of matches found.
' Assumes:      None.
' Side Effects:
' Tested:       By the calls shown below.
Const strcBkMk As String = "intRemoveText"
Dim lngStart As Long
Dim lngEnd As Long
Dim intDiff As Integer
intRemoveText = 0
WordBasic.EditFind Find:=strFirst, Direction:=0, WholeWord:=0, Format:=0
WordBasic.EditBookmark Add:=1, Name:=strcBkMk
While WordBasic.EditFindFound()
    lngStart = WordBasic.GetSelStartPos()
    WordBasic.EditBookmark Add:=1, Name:=strcBkMk
    WordBasic.CharRight
    WordBasic.EditFind Find:=strLast
    lngEnd = WordBasic.GetSelEndPos()
    intDiff = lngEnd - lngStart
    If (Abs(intDelta - intDiff)) / intDelta < (intFuzz / 100) Then
        intRemoveText = intRemoveText + 1
        WordBasic.SetSelRange lngStart, lngEnd
        WordBasic.WW6_EditClear
        WordBasic.CharRight
    Else
        WordBasic.EditBookmark GoTo:=1, Name:=strcBkMk
        WordBasic.EditBookmark Delete:=1, Name:=strcBkMk
        WordBasic.CharLeft
        WordBasic.CharRight
    End If
    WordBasic.EditFind Find:=strFirst, Direction:=0, WholeWord:=0, Format:=0
Wend
'Sub TESTintRemoveText() ' This test runs on the text shown below.
'MsgBox intRemoveText("This", "modules", 75, 10) ' Estimate 75 chars per line, 10% tolerance.
'End Sub
End Function

We all knew nothing when we started …
Home Page and Contact Information
Send email to [email protected].
This page was last updated Thursday, November 15, 2001

 

 

Hosted by www.Geocities.ws

1