#1
|
|||
|
|||
Macro to convert first word of each section to Drop Caps
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 |
#2
|
|||
|
|||
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... |
#3
|
|||
|
|||
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 | |
Display Modes | |
|
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 |