If then statement to for existing style in a word document

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

kurt - 04 Oct 2007 21:35 GMT

Hello,

I have written the following code to test for the existence of a style
(block text 2). If the style exists in the document, I want it to be applied
to the text. If not, the macro should create the style and then apply it.
Each major section works separately, but not together. Any ideas what I'm
missing?

Thanks!

Kurt

Sub blocktext2()
'
' blocktext2 Macro
' Macro recorded 10/4/2007 by Kurt Metzger
'
' Dim styStyle As Style
' Dim sMsg As String
' Dim sStyleName As String
' sStyleName = "Block Text 2"
'' For Each styStyle In ActiveDocument.Styles
' ' Does the style exist?
' If styStyle.NameLocal = sStyleName Then

If ActiveDocument.Styles("Block Text 2").InUse = True Then

Selection.Style = ActiveDocument.Styles("Block Text 2")

Else
ActiveDocument.Styles.Add Name:="Block Text 2", Type:=wdStyleTypeParagraph
ActiveDocument.Styles("Block Text 2").AutomaticallyUpdate = False
With ActiveDocument.Styles("Block Text 2").Font
.Name = "Times New Roman"
.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 = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 0
.Animation = wdAnimationNone
End With
With ActiveDocument.Styles("Block Text 2").ParagraphFormat
.LeftIndent = InchesToPoints(0)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 12
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphJustify
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
ActiveDocument.Styles("Block Text
2").NoSpaceBetweenParagraphsOfSameStyle _
= False
ActiveDocument.Styles("Block Text 2").ParagraphFormat.TabStops.ClearAll
With ActiveDocument.Styles("Block Text 2").ParagraphFormat
With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = False
End With
End With
ActiveDocument.Styles("Block Text 2").LanguageID = wdEnglishUS
ActiveDocument.Styles("Block Text 2").NoProofing = False
ActiveDocument.Styles("Block Text 2").Frame.Delete

Selection.Style = ActiveDocument.Styles("Block Text 2")

End If
End Sub

Reply to this Message

Klaus Linke - 05 Oct 2007 01:14 GMT

One way would be to just go ahead and apply the style, and use an error
handler in case that fails.

Function bApplyStyle(sName As String) As Boolean
On Error GoTo Errhandler
Selection.Style = ActiveDocument.Styles(sName)
bApplyStyle = True
Exit Function
Errhandler:
If Err.Number = 5941 Then
' define style if it does not exist
ActiveDocument.Styles.Add Name:=sName, Type:=wdStyleTypeParagraph
bApplyStyle = False
Else
MsgBox Err.Description, vbCritical, "Unhandled Error " & Err.Number
End If
Err.Clear
End Function

Sub TestMacro1()
Dim sNameLocal As String
sNameLocal = InputBox("Enter the style name:", "Test")
' apply style through the function, and define its properties if it
returns "False"
If Not bApplyStyle(sNameLocal) Then
MsgBox "Add code to define style " & sNameLocal
ActiveDocument.Styles(sNameLocal).Font.Bold = True ' ...
End If
End Sub

Else you would have to look through all styles whether the style you want to
appy already exists:

Function bStyleExists(sName As String) As Boolean
Dim myStyle As Style
bStyleExists = False
For Each myStyle In ActiveDocument.Styles
If myStyle.NameLocal = sName Then
bStyleExists = True
Exit For
End If
Next myStyle
End Function

Sub TestMacro2()
Dim sNameLocal As String
sNameLocal = InputBox("Enter the style name:", "Test")
If bStyleExists(sNameLocal) Then
MsgBox "Exists"
Else
MsgBox "Does not Exist"
End If
End Sub

But actually, that works less well because NameLocal vary from language
version to language version, and because you would run into difficulties
with alias style names.

Regards,
Klaus

> Hello,
>
[quoted text clipped - 105 lines]
> End If
> End Sub

Reply to this Message

Rate this thread: