need some change in this

balavaka · #1 03-18-2022, 07:41 PM

I need to find and change only on paragraphs which tag contains like at start (e.g. <S1>, <S2>, <S3>)

Sub TitleCase()
Dim lclist As String
Dim wrd As Integer
Dim sTest As String

' list of lowercase words, surrounded by spaces
lclist = " of the by to this is from a and in with on for through are they via at an as "

Selection.Range.Case = wdTitleWord

For wrd = 2 To Selection.Range.Words.Count
sTest = Trim(Selection.Range.Words(wrd))
sTest = " " & LCase(sTest) & " "
If InStr(lclist, sTest) Then
Selection.Range.Words(wrd).Case = wdLowerCase
End If
Next wrd
End Sub

gmayor · #2 03-18-2022, 10:48 PM

Based on my TrueTitleCase macro

Code:

Sub ChangeCaseTagged()
Dim oPara As Paragraph
Dim oRng As Range
    For Each oPara In ActiveDocument.Range.Paragraphs
        Set oRng = oPara.Range
        oRng.End = oRng.End - 1
        If oRng.Text Like "<S*>*" Then
            If Len(oRng.Text) > 0 Then TrueTitleCase oRng
        End If
    Next oPara
lbl_Exit:
    Set oPara = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Sub TrueTitleCase(rSel As Range)
'Graham Mayor - https://www.gmayor.com - Last updated - 18 Mar 2022
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long

    'count the characters in the selected string
    'format the selected string as title case
    vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _
                      "If", "In", "Of", "On", "Or", "The", "To", "With")
    'list their replacements in a matching array
    vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _
                      "if", "in", "of", "on", "or", "the", "to", "with")
    With rSel
        .Case = wdTitleWord
        'omit the first word
        .MoveStart unit:=wdWord, Count:=1
        'list the exceptions to look for in an array
        With .Find
            'replace items in the first list
            'with the corresponding items from the second
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindStop
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Format = True
            .MatchCase = True
            For i = LBound(vFindText) To UBound(vFindText)
                .Text = vFindText(i)
                .Replacement.Text = vReplText(i)
                .Execute Replace:=wdReplaceAll
            Next i
        End With
    End With
lbl_Exit:
    Set rSel = Nothing
    Exit Sub
End Sub

balavaka · #3 03-18-2022, 10:58 PM

can we include any other tag other than <S1> <S2> like (e.g. <FG>, <TC>)

gmayor · #4 03-19-2022, 03:43 AM

Change the first part to

Code:

Sub ChangeCaseTagged()
Dim oPara As Paragraph
Dim oRng As Range
    For Each oPara In ActiveDocument.Range.Paragraphs
        Set oRng = oPara.Range
        oRng.End = oRng.End - 1
        If oRng.Text Like "<S*>*" Or _
           oRng.Text Like "<FG>*" Or _
           oRng.Text Like "<TC>*" Then
            If Len(oRng.Text) > 0 _
               Then TrueTitleCase oRng
        End If
    Next oPara
lbl_Exit:
    Set oPara = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Change Event to change cell in same row doesn't work if user clicks other row	Peterson	Excel Programming	4	05-10-2021 04:59 PM
Track changes problem: When I hover over a change, the bubble with change info. flashes rapidly	Thankful	Word	0	01-29-2021 09:04 AM
How to change and implement default theme font style change	Nikko963	Word	5	05-04-2018 09:11 AM
Change computer's time, and all appointment times in Outlook's calendar change	TimTDP	Outlook	0	03-14-2017 06:56 AM
change the view to final, my change bars disappear. I need them visible	anna.a.julin	Word	1	03-01-2012 08:05 PM