Converts the words to actual All Capital Letters not workin macro??

powerdrum · #1 12-08-2011, 08:45 AM

This macro below for some reason is not going through the whole document or all the words to covert, can someone help on this!!!!
We are using microsoft Word 2010.
Thanks!!

Sub Convert_AllCaps_FontFormatting()

'This macro goes through the document and checks the
'Font attributes on the Words for All Caps.
'If the attribute is found then it converts the
'words to actual All Capital Letters.

For a = 1 To ActiveDocument.Words.Count
ActiveDocument.Words(a).Select

If Selection.Font.AllCaps = True Then
Selection.Range.Case = wdUpperCase
End If

Next a
End Sub

Stefan Blom · #2 12-08-2011, 03:31 PM

I suspect you have to look at this character by character for it to work properly:

Dim c As Range

For Each c In ActiveDocument.Characters
If c.Font.AllCaps = -1 Then
c.Case = wdUpperCase
End If
Next c

macropod · #3 12-08-2011, 05:06 PM

Hi Powerdrum,

Try:

Code:

Sub Demo()
Dim MyData As DataObject, strClip As String, i As Long
Set MyData = New DataObject
With ActiveDocument.Content
  With .Find
    .ClearFormatting
    .Text = ""
    With .Font
      .SmallCaps = False
      .AllCaps = True
    End With
    With .Replacement
      .Text = ""
      .ClearFormatting
    End With
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .Copy
    MyData.GetFromClipboard
    .Text = MyData.GetText
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  With .Find
    .Wrap = wdFindContinue
    With .Replacement.Font
      .SmallCaps = False
      .AllCaps = False
    End With
    .Execute Replace:=wdReplaceAll
  End With
End With
End Sub

Note: You'll need to add a reference to the MS Forms object library.

Alternatively, you might prefer this simplified version, which doesn't need a reference to the MS Forms object library:

Code:

Sub Demo()
With ActiveDocument.Content
  With .Find
    .ClearFormatting
    .Text = ""
    With .Font
      .SmallCaps = False
      .AllCaps = True
    End With
    With .Replacement
      .Text = ""
      .ClearFormatting
    End With
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .Cut
    .PasteSpecial DataType:=wdPasteText
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro for highlighting specific number of words	icsjohn	Word VBA	2	12-07-2011 06:44 PM
Croatian characters such as a capital C w/ accent acute?	vhindley	Word	3	07-08-2011 03:39 AM
Why the "Headings" are appearing in capital letters in the Table of contents?	Jamal NUMAN	Word	1	05-31-2011 08:31 AM
safe sender list not workin	LA1976	Outlook	0	05-23-2011 03:27 AM
MS Project able to import actual start and or actual finish date from Excel?	mhacker	Project	0	04-26-2010 11:29 AM