programmatically apply / change styles

[mancubus]

hi all.

a have a number of inherited documents written as a plain text. a sample is included in the attached "before.docm" file.

headings are indicated by "(Hx)" (x being the heading level) in front of the line.

i found a FR code, adopted it to convert these lines into headings.



Sub Apply_Headings()


Application.ScreenUpdating = False


For i = 1 To 4
With ActiveDocument.Content.Find
.ClearFormatting
.Text = "(H" & i & ")"
With .Replacement
.Text = "^&"
.ClearFormatting
.Style = Choose(i, wdStyleHeading1, wdStyleHeading2, wdStyleHeading3, wdStyleHeading4)
End With
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
Next
Application.ScreenUpdating = True


End Sub




as can be seen in after.docm file, it does -more or less- what i expect for H1, H3 and H4's. but for H2's, it applies completely different format. i think it is because of preset H2 format of overwritten old document.

i recorded a macro while manually changing the Current H2 format:

Font: (Default) +Headings (Cambria), 12 pt, Font color: Accent 2, All caps, English (United States), Expanded by 0,75 pt, Centered
Line spacing: Multiple 1,05 li, Space
Before: 20 pt, Level 2, Border:
Bottom: (Single solid line, Accent 2, 0,5 pt Line width), Style: Linked, Hide until used, Show in the Styles gallery, Priority: 10
Based on: Normal
Following style: Normal



to Desired H2 format:

Font: (Default) Arial, 12 pt, Bold, Font color: Accent 1, All caps, English (United States), Expanded by 0,75 pt
Line spacing: Multiple 1,05 li, Space
Before: 20 pt, Level 2, Border:
Bottom: (Single solid line, Accent 2, 0,5 pt Line width), Style: Linked, Automatically update, Hide until used, Show in the Styles gallery, Priority: 10
Based on: Normal
Following style: Normal




here is what i get:


Sub Macro1()

With ActiveDocument.Styles("Heading 2").Font
.Name = "Arial"
.Size = 12
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = True
.Color = -738131969
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0.75
.Scaling = 100
.Kerning = 0
.Animation = wdAnimationNone
.Ligatures = wdLigaturesNone
.NumberSpacing = wdNumberSpacingDefault
.NumberForm = wdNumberFormDefault
.StylisticSet = wdStylisticSetDefault
.ContextualAlternates = 0
End With
With ActiveDocument.Styles("Heading 2").ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 20
.SpaceBeforeAuto = False
.SpaceAfter = 10
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = LinesToPoints(1.05)
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevel2
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
.CollapsedByDefault = False
End With
ActiveDocument.Styles("Heading 2").NoSpaceBetweenParagraphsOfSameStyle = _
False
With ActiveDocument.Styles("Heading 2")
.AutomaticallyUpdate = True
.BaseStyle = "Normal"
.NextParagraphStyle = "Normal"
End With
End Sub





the problem is i cant see an option to remove border (red bolded part).

what i need are:
- change the H2's formats similar to H1, H3, H4's format as i did manually but without bottom border line.
- change "(Hx)"s to incrementing numbers for each level,
- simplify the recorded macro by removing default parameter lines.
- insert a TOC starting at page2.

any help is highly appreciated.

thanks.

[mancubus]

this is second file.

[macropod]

The Styles dialogue gives you the option to change the border via Format>Border. I don't know why you'd bother recording all this as a macro, though, as you'd only need to do it once for a given document then use the organizer to propagate the change to all of the documents concerned.

[mancubus]

thanks for the reply Paul.

[snb]

Sub M_snb()
ThisDocument.Styles("heading 2").Borders.Enable = False

With ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
For i = 1 To 4
.Replacement.Style = -1 - i
.Execute "(H" & i & ")", , , , , , , , True, , 2
Next
End With
End Sub

[mancubus]

thanks for the code snb.

i added 2 lines for font color and left alignment.



Sub M_snb()

With ThisDocument.Styles("Heading 2")
.Borders.Enable = False
.Font.Color = -738131969
.ParagraphFormat.Alignment = wdAlignParagraphLeft
End With

With ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
For i = 1 To 4
.Replacement.Style = -1 - i
.Execute "(H" & i & ")", , , , , , , , True, , 2
Next
End With
End Sub



i'm hopig to benefit from
http://shaunakelly.com/word/numbering/numbering20072010.html
for numbering the headings.

[snb]

It's not clear to me what kind of numbering result you want.

[mancubus]

thanks for the reply.

sorry about that. i should have said before.


1 HEADING1
1.1 HEADING2
1.1.1 HEADING3
1.1.2 HEADING3
1.2 HEADING2
1.2.1 HEADING3
1.2.1.1 HEADING4
1.2.1.2 HEADING4
1.2.1.3 HEADING4
1.2.2 HEADING3

2 HEADING1
2.1 HEADING2
2.1.1 HEADING3
2.1.2 HEADING3
2.2 HEADING2
2.2.1 HEADING3
2.2.1.1 HEADING4
2.2.1.2 HEADING4

[snb]

Sub M_snb()
For j = 1 To 9
With ListGalleries(3).ListTemplates(1).ListLevels(j)
.NumberFormat = Choose(j, "%1", "%1.%2", "%1.%2.%3", "%1.%2.%3.%4", "%1.%2.%3.%4.%5", "%1.%2.%3.%4.%5.%6", "%1.%2.%3.%4.%5.%6.%7", "%1.%2.%3.%4.%5.%6.%7.%8", "%1.%2.%3.%4.%5.%6.%7.%8.%9")
.TrailingCharacter = 0
.NumberStyle = 0
.NumberPosition = CentimetersToPoints(0)
.Alignment = 0
.TextPosition = CentimetersToPoints(0.51 + j * 0.25)
.ResetOnHigher = 0
.StartAt = 1
.LinkedStyle = "Heading " & j
End With
Next

With ThisDocument.Styles("Heading 2")
.Borders.Enable = False
.Font.Color = -738131969
.ParagraphFormat.Alignment = wdAlignParagraphLeft
End With

With ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
For i = 1 To 4
.Replacement.Style = -1 - i
.Execute "(H" & i & ")", , , , , , , , True, , 2
Next
End With
End Sub

[mancubus]

thanks snb.

the first part of the code creates a new list style, i think.
.
after running the macro, i selected headings one by one, clicked Multilevel List from Home/Paragraphs, selected 1 Heading1, 1.1 Heading2, 1.1.1 Heading3, etc from list library. this changed the format of the headings but numbered as desired.

do i have to process manually all the headings (in all files) like this. or am i missing something.

[macropod]

after running the macro, i selected headings one by one, clicked Multilevel List from Home/Paragraphs, selected 1 Heading1, 1.1 Heading2, 1.1.1 Heading3, etc from list library. this changed the format of the headings but numbered as desired.

do i have to process manually all the headings (in all files) like this. or am i missing something.
If you update the heading format in the documents' template, you could then use a Document_Open macro in the template to either:
(a) check the document's 'Automatically update document styles' property next time it's opened then, if you wish, un-check it again. This will update all Styles, over-riding any definition changes in the documents concerned. That's OK if you're trying to enforce consistency, but will earn you some opprobrium otherwise; or
(b) update just the specified Styles.
In either case, if the same template is being used for other purposes (i.e. your documents mis-use it) the above will cause problems. At that point the best approach might be to define a new template for these documents and attach them to that. Once the template is defined, a macro could be used to loop through all of the affected documents (ideally by placing them in a common folder with no other documents), attach them to the template and do the Style updating. IMHO, trying to re-define the Styles on a document-by-document basis is the wrong way to go about the task.

[mancubus]

thanks snb.

the first part of the code creates a new list style, i think.
.
after running the macro, i selected headings one by one, clicked Multilevel List from Home/Paragraphs, selected 1 Heading1, 1.1 Heading2, 1.1.1 Heading3, etc from list library. this changed the format of the headings but numbered as desired.

do i have to process manually all the headings (in all files) like this. or am i missing something.


i'm a very bad ms word user. :)

that was a built-in style.

so after the paragraphs with "(Hx) " are converted into headings, should numbering happen at the same time?

[snb]

The first part of the code applies a numbering style to each of the builtin heading styles.

After running the macro the headers are being applied according to your specification: headers & numbering.

[mancubus]

thanks snb.

sorry for being trouble but what i'm trying to say is the codes in post#6 and post#9 do the same; ie no numbers before header.

[mancubus]

thanks for the pointers Paul.

as i'm not familiar with these, i think i need a self-training on them. :)

[macropod]

the codes in post#6 and post#9 do the same; ie no numbers before header.
Try:

Dim j As Long, LT As ListTemplate
Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
For j = 1 To 9
With LT.ListLevels(j)
.NumberFormat = Choose(j, "%1", "%1.%2", "%1.%2.%3", "%1.%2.%3.%4", "%1.%2.%3.%4.%5", "%1.%2.%3.%4.%5.%6", "%1.%2.%3.%4.%5.%6.%7", "%1.%2.%3.%4.%5.%6.%7.%8", "%1.%2.%3.%4.%5.%6.%7.%8.%9")
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(0.5 + j * 0.25)
.ResetOnHigher = True
.StartAt = 1
.LinkedStyle = "Heading " & j
End With
Next

[mancubus]

thanks for your time and efforts Paul & snb.

:thumb :clap:

solved.

the only thing left is inserting a ToC. but i can find it via google/macro recorder.



sorry for the use of "header" instead of "heading".

[mancubus]

for those who may need a similar solution, the entire code is:



Sub snb_macropod()

Dim j As Long, LT As ListTemplate

With ActiveDocument.Styles("Heading 2")
.Borders.Enable = False
.Font.Color = -738131969
.ParagraphFormat.Alignment = wdAlignParagraphLeft
End With

With ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
For i = 1 To 4
.Replacement.Style = -1 - i
.Execute "(H" & i & ")", , , , , , , , True, , 2
Next
End With

With ActiveDocument.Content.Find
.ClearFormatting
.Text = "[(]H?[)] "
.Replacement.ClearFormatting
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With

Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
For j = 1 To 9
With LT.ListLevels(j)
.NumberFormat = Choose(j, "%1", "%1.%2", "%1.%2.%3", "%1.%2.%3.%4", "%1.%2.%3.%4.%5", "%1.%2.%3.%4.%5.%6", "%1.%2.%3.%4.%5.%6.%7", "%1.%2.%3.%4.%5.%6.%7.%8", "%1.%2.%3.%4.%5.%6.%7.%8.%9")
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(0.5 + j * 0.25)
.ResetOnHigher = True
.StartAt = 1
.LinkedStyle = "Heading " & j
End With
Next
End Sub



convert unformatted content like this:
(H1) HEADING1
(H2) HEADING2
(H2) HEADING2
(H1) HEADING1
(H2) HEADING2
(H3) HEADING3
(H4) HEADING4

into
1 HEADING1
1.1 HEADING2
1.1.1 HEADING3
1.1.2 HEADING3
1.2 HEADING2
1.2.1 HEADING3
1.2.1.1 HEADING4
1.2.1.2 HEADING4
1.2.1.3 HEADING4
1.2.2 HEADING3

2 HEADING1
2.1 HEADING2
2.1.1 HEADING3
2.1.2 HEADING3
2.2 HEADING2
2.2.1 HEADING3
2.2.1.1 HEADING4
2.2.1.2 HEADING