Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 07-29-2022, 11:55 PM
wrdy wrdy is offline Macro to convert first word of each section to Drop Caps Windows XP Macro to convert first word of each section to Drop Caps Office 2007
Novice
Macro to convert first word of each section to Drop Caps
 
Join Date: Jan 2014
Posts: 28
wrdy is on a distinguished road
Default 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
Attached Images
File Type: png before.png (52.4 KB, 29 views)
File Type: png after.png (53.6 KB, 27 views)
File Type: png target.png (270.6 KB, 28 views)
Attached Files
File Type: docx sample text.docx (14.3 KB, 10 views)
Reply With Quote
  #2  
Old 05-30-2023, 05:01 AM
mordyas mordyas is offline Macro to convert first word of each section to Drop Caps Windows 10 Macro to convert first word of each section to Drop Caps Office 2016
Novice
 
Join Date: May 2023
Posts: 1
mordyas is on a distinguished road
Default

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...
Reply With Quote
  #3  
Old 05-30-2023, 01:20 PM
gmaxey gmaxey is offline Macro to convert first word of each section to Drop Caps Windows 10 Macro to convert first word of each section to Drop Caps Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,421
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

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
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
Reply

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
Macro to convert first word of each section to Drop Caps Word macro to change ALL CAPS to UPPERCASE dita Word VBA 14 05-20-2018 10:56 PM
Macro to convert first word of each section to Drop Caps 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
Macro to convert first word of each section to Drop Caps 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

Other Forums: Access Forums

All times are GMT -7. The time now is 07:24 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft