Visual Basic Library

This page was last updated on Saturday, November 24, 2001
Public Function AddStyle(strStylename)
' Procedure :   AddStyle
' Description:  Adds a style to the active document.
' By:           Chris Greaves Inc.
' Inputs:       STRING style name.
' Returns:      None.
' Assumes:      The named style does not already exist.
' Side Effects: The active document will become "dirty". See e.g. my macro AutoClose.
' Tested:       By the calls below.
' Note that you should test for the existence of your style before calling this procedure.
' If the style already exists and you try to add it again you'll get a '5173' error.
' In the procedure body I have placed and then comented out examples of code to add an Outline list.
' In the procedure body I have placed examples of code to set the font colour to be red.
' You can use this procedure as a skeleton to add specific charcteristics
'     by employing parameters for things like typeface, size, colour etc.
    Dim oLstTemplate
    ActiveDocument.Styles.Add Name:=strStylename, Type:=wdStyleTypeParagraph
    With ActiveDocument.Styles(strStylename)
'        .AutomaticallyUpdate = False
        .BaseStyle = "Normal"
'        .ParagraphFormat.SpaceAfter = 6
        .Font.ColorIndex = wdRed
    End With
'    Set oLstTemplate = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
'    With oLstTemplate.ListLevels(1)
'        .NumberFormat = ChrW(61692)
'        .TrailingCharacter = wdTrailingTab
'        .NumberStyle = wdListNumberStyleBullet
'        .NumberPosition = InchesToPoints(0)
'        .Alignment = wdListLevelAlignLeft
'        .TextPosition = InchesToPoints(0.25)
'        .TabPosition = wdUndefined
'        .ResetOnHigher = True
'        .StartAt = 1
'        With .Font
'            .ColorIndex = wdRed
'            .Name = "Wingdings"
'        End With
'        .LinkedStyle = strStylename
'    End With
'    ActiveDocument.Styles(strStylename).LinkToListTemplate ListTemplate:=oLstTemplate, ListLevelNumber:=1
'Sub TESTAddStyle()
'Call AddStyle("ERASEME") ' should work the first time
'Call AddStyle("ERASEME") ' should generate an error '5173' the second time.
'End Sub
End Function