Macro to convert first word of each section to Drop Caps

wrdy · #1 07-29-2022, 11:55 PM

I have a macro that converts the first letter of the first word of each section to Drop Caps. However I would like some help editing the macro so that it will convert the whole first word to Drop Caps, rather than just the first letter. The space after the first word also needs to be deleted in order to keep the left alignment.

I have attached images showing a document before running the macro, after running the macro, and what I want the new macro to do.

Code:

Sub DropCaps()
Dim oSection As Section
Dim i As Integer
    For Each oSection In ActiveDocument.Sections
        For i = 1 To oSection.Range.Paragraphs.Count
            If Len(oSection.Range.Paragraphs(i).Range) > 1 Then
                Exit For
            End If
        Next i
        With oSection.Range.Paragraphs(i).DropCap
            .Position = wdDropNormal
            .LinesToDrop = 2
            .DistanceFromText = CentimetersToPoints(0.1)
        End With
    Next oSection
    Set oSection = Nothing
End Sub

mordyas · #2 05-30-2023, 05:01 AM

Hi
Try this. It worked for me' in Hebrew version.
===================
Sub A_A_OPEN_WORD()
'
' Sub A_A_OPEN_WORD
'
'
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.HomeKey Unit:=wdLine
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.Copy
Selection.HomeKey Unit:=wdLine
With Selection.Paragraphs(1).dropCap
.position = wdDropNormal
.fontName = "Ezra SIL SR dec2"
.LinesToDrop = 2
.DistanceFromText = 12
'
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.font.SizeBi = 30
With Selection.font
.Spacing = 0
.Scaling = 100
.position = 6
.Kerning = 0
.SizeBi = 30
.NameBi = "Ezra SIL SR dec2"
.BoldBi = False
.ItalicBi = False
End With
With Selection
.Collapse Direction:=wdCollapseStart
.CopyFormat
.Next(Unit:=wdWord, Count:=-1).Select
.PasteFormat
End With
'
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.HomeKey Unit:=wdLine
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

End Sub
===================
I'm no "expert" at writing code, but somehow I managed to put this thing together - and it works together.
The code goes to the first word in the paragraph, copies it, and builds a "DropCap" from it.
Then he adds the design (DropCap design, paragraph and font) and finally adds the first word that has already been copied to DropCap.
Says again:
I'm not an expert. It works for me.
At your place - at your own risk...

gmaxey · #3 05-30-2023, 01:20 PM

Code:

Sub DropCaps()
Dim oSection As Section
Dim lngIndex As Integer
Dim oRng As Range
Dim strText As String
  For Each oSection In ActiveDocument.Sections
    For lngIndex = 1 To oSection.Range.Paragraphs.Count
      If Len(oSection.Range.Paragraphs(lngIndex).Range) > 1 Then
        Exit For
      End If
    Next lngIndex
    Set oRng = oSection.Range.Paragraphs(lngIndex).Range
    strText = oRng.Words(1).Text
    oRng.Collapse wdCollapseStart
    oRng.Select
    With oSection.Range.Paragraphs(lngIndex).DropCap
      .Position = wdDropNormal
      .LinesToDrop = 2
      .DistanceFromText = CentimetersToPoints(0.1)
    End With
    Selection.Paragraphs(1).Next.Range.Words(1).Delete
    Selection.Text = strText
    Selection.Characters.Last.Next.Delete
   Next oSection
    Set oSection = Nothing
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Powerpoint-2019 Text in selected theme remains in All Caps even when small caps option is selected	Tanasha4	PowerPoint	2	04-06-2019 07:53 PM
Word macro to change ALL CAPS to UPPERCASE	dita	Word VBA	14	05-20-2018 10:56 PM
Need a Macro to Change Every Instance of Small Caps to All Caps and Reduce the Font by 2 Points	CrossReach	Word VBA	2	11-13-2017 09:21 AM
Drop Caps Problem	dustnik	Word	5	12-12-2016 01:14 PM
Multiple drop caps	Ziggy-R	Publisher	0	10-26-2010 06:23 PM