View Single Post
 
Old 12-10-2013, 06:24 PM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,342
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Marrick,

Try the following. One of my aims has been getting the 'TrueTitleCase' module coded so that it doesn't depend on being within a table. The main issue with the data you've been working with is that it seems to me a given cell may have one or more sentences, each of which needs to be processed separately. Equally, if the first row has two cells, each is a separate sentence and would need to be processed separately. Of course, I may be wrong on both counts and each row might only ever have one sentence. To handle that, I've been using the sentences collection as you know.

There are two problems with using the sentences collection, the first of which is that Word's idea of a sentence isn't necessarily what you or I would think of as a sentence. For example, any abbreviation terminated by a period (such as Mr., Mrs., etc.) is counted by VBA as a sentence. So far it doesn't seem that's an issue. The second problem is that, where table cells are concerned, it seems Word collapses the sentence range to just the cell marker is if doesn't find a character like '.' or '?' and the cell is the last one on the row. That's why my previous coding for the sentences collection didn't work properly with your data - mine had the periods and/or rows with two or more cells.
Code:
Sub TrueTitleCase(Rng As Range)
Dim RngTxt As Range, ArrTxt(), i As Long, j As Long
'list the exceptions to look for in an array
ArrTxt = Array("A", "An", "And", "As", "At", "But", "By", _
  "For", "If", "In", "Of", "On", "Or", "The", "To", "With")
With Rng
  For i = 1 To .Sentences.Count
    Set RngTxt = .Sentences(i)
    With RngTxt
      .End = .End - 1
      If .Information(wdWithInTable) And .Start = .End Then
        .MoveStart wdCell, -1
        .End = .End - 1
      End If
      .MoveStart wdWord, 1
      With .Find
        'replace items in the list
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Format = False
        .MatchCase = True
        For j = LBound(ArrTxt) To UBound(ArrTxt)
          .Text = ArrTxt(j)
          .Replacement.Text = LCase(ArrTxt(j))
          .Execute Replace:=wdReplaceAll
        Next j
      End With
      While InStr(.Text, ":") > 0
        .MoveStartUntil ":", wdForward
        .Start = .Start + 1
        .MoveStartWhile " ", wdForward
        .Words.First.Case = wdTitleWord
      Wend
    End With
  Next i
End With
End Sub
FWIW, I've previously coded a much more elaborate 'ProperCase' function you may be interested in: http://www.techsupportforum.com/foru...-a-643881.html. This one handles surnames beginning with Mc, Mac & O' as well.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote