GregQik
06-09-2013, 01:25 AM
Using Office 2010 version of Word.
Attempting to create styles without linked styles (Paragraph Style + Char Style) with VBA.
Unable to to set .linked = false.
ActiveDocument.Styles.Add(Name:=strNewStyle, Type:=intStyleType, Linked:=False)
Creating the style manually permits the linked styles attribute to be turned off.
Public Function xfn_StyleAdd(strNewStyle As String, intStyleType As WdStyleType) As Boolean
'------------------------------------------Vrs 3.04 dated 14Jan2011 -----------------
' Procedure : xfn_StyleAdd
' DateTime : 11 Apr 2007 20:46 Last Edited : 14 Apr 2007 10:11 in (Sect5)
' Author : Greg Quick
' Purpose : Add a style name if the style does not exist.
' Syntax : booReturn = xfn_StyleAdd (strNewStyle, intStyleType) ' (strNewStyle As String, intStyleType as WdStyleType) _
(wdStyleTypeParagraph, wdStyleTypeCharacter, wdStyleTypeList,or wdStyleTypeTable)
'---------------------------------------------------------------------------------------
'Inputs : strNewStyle As String, intStyleType as Integer
'Outputs : xfn_StyleAdd as boolean
'Dependencies : xfn_StyleExist
'---------------------------------------------------------------------------------------
Const strMacroName As String = "xfn_StyleAdd": Const ERRSourceTitle As String = ThisProjectName & " ! " & AA_Module__Name & " . " & strMacroName: Const booLogErrors As Boolean = False 'error logging is off
Const Err_HandlerOn = True: Const DEBUG_Level = 1 ' List Debug Code Snippets : [Ctrl]+[Shift]+[F3]
Dim strErrLabel As String, booReturn As Boolean, strTempErr As String, strERRTitleWithLabel As String, booErrorBreak As Boolean, booFirstErrRun As Boolean, strTemp(3) As String 'Err Variables
Dim strMsg As String, strTitle As String, intButtonStyle As Integer, lngContext As Long, intButtonReturn As Integer ' STD GGQ msgbox variables
booErrorBreak = True: strErrLabel = "_Begin": booFirstErrRun = True ' Error Handling Values
'--------------------------------------------------------------------------------------
If Err_HandlerOn Then On Error GoTo xfn_StyleAdd_Error: Call SetErrObject(ERRSourceTitle) 'Ensure Custom Err Object is initialised
'------------------------------------------------------------------------------------------------------------------
xfn_StyleAdd_Code: strErrLabel = "xfn_StyleAdd_Code": strERRTitleWithLabel = ERRSourceTitle & "@" & strErrLabel ' Procedure Code below ----------------- xfn_StyleAdd_Code:
' --------------------------------------- Debug Code Above
Dim thisNewStyle As Style
booReturn = xfn_StyleExist(strNewStyle)
If Not booReturn Then
Set thisNewStyle = ActiveDocument.Styles.Add(Name:=strNewStyle, Type:=intStyleType , Linked:=False)
#If VBA7 Then
' thisNewStyle.Linked = False
#End If
End If
'-------------------------------------
GoTo xfn_StyleAdd_ExitFunction ' Skip to Exit
'------------------------------------- Error Handler Framework Dated 4.00 dated Saturday, 15Jan2011 00:47:14
xfn_StyleAdd_Error: ' Error handler
'------------------------------------- Mini-Error Handler Code V4.00 Dated Saturday, 15Jan2011 00:47:14
'-------------------------------------Full Error Handler Code V4.00 dated Saturday, 15Jan2011 00:47:14
ERR.AddDetails ThisProjectName, AA_Module__Name, strMacroName, strErrLabel, Erl, booErrorBreak
Select Case ERR.Number ' Requires Custom Error Object
Case Else 'Standard error no change
strTempErr = ERR.Description & vbCrLf & vbCrLf & _
"New Style Name: '" & strNewStyle & "'"
ERR.Restore: strTempErr = ERR.Description
ERR.Pop 'Remove highest stack instance before push
With ERR 'push and pop handled insed err.object
.Description = strTempErr: .ParameterA = ""
.BreakOnError = True: .ParameterB = ""
End With
End Select ' Case Err.Number
ERR.Push ' ------------------------------ After Amendments
Call GetErrDescr(ERR) ' set custom message and helpfile context (show error message from function)
ERR.Pop: If Not ERR.BreakOnError Then ERR.Clear: On Error GoTo xfn_StyleAdd_Error: Resume Next:
xfn_StyleAdd_ErrorCleanup: 'Cleanup for error crash
ERR.Clear: Call xfn_ErrorCleanup: End 'Generic Cleanup routine for host specific statements
Exit Function 'Future expansion to allow error to walk up the chain
'-----------------------------------------------------------------------
xfn_StyleAdd_ExitFunction: 'Single exit point for all jumps
xfn_StyleAdd = xfn_StyleExist(strNewStyle)
End Function ' End xfn_StyleAdd Function
Is this task possible using Word 2010?
Attempting to create styles without linked styles (Paragraph Style + Char Style) with VBA.
Unable to to set .linked = false.
ActiveDocument.Styles.Add(Name:=strNewStyle, Type:=intStyleType, Linked:=False)
Creating the style manually permits the linked styles attribute to be turned off.
Public Function xfn_StyleAdd(strNewStyle As String, intStyleType As WdStyleType) As Boolean
'------------------------------------------Vrs 3.04 dated 14Jan2011 -----------------
' Procedure : xfn_StyleAdd
' DateTime : 11 Apr 2007 20:46 Last Edited : 14 Apr 2007 10:11 in (Sect5)
' Author : Greg Quick
' Purpose : Add a style name if the style does not exist.
' Syntax : booReturn = xfn_StyleAdd (strNewStyle, intStyleType) ' (strNewStyle As String, intStyleType as WdStyleType) _
(wdStyleTypeParagraph, wdStyleTypeCharacter, wdStyleTypeList,or wdStyleTypeTable)
'---------------------------------------------------------------------------------------
'Inputs : strNewStyle As String, intStyleType as Integer
'Outputs : xfn_StyleAdd as boolean
'Dependencies : xfn_StyleExist
'---------------------------------------------------------------------------------------
Const strMacroName As String = "xfn_StyleAdd": Const ERRSourceTitle As String = ThisProjectName & " ! " & AA_Module__Name & " . " & strMacroName: Const booLogErrors As Boolean = False 'error logging is off
Const Err_HandlerOn = True: Const DEBUG_Level = 1 ' List Debug Code Snippets : [Ctrl]+[Shift]+[F3]
Dim strErrLabel As String, booReturn As Boolean, strTempErr As String, strERRTitleWithLabel As String, booErrorBreak As Boolean, booFirstErrRun As Boolean, strTemp(3) As String 'Err Variables
Dim strMsg As String, strTitle As String, intButtonStyle As Integer, lngContext As Long, intButtonReturn As Integer ' STD GGQ msgbox variables
booErrorBreak = True: strErrLabel = "_Begin": booFirstErrRun = True ' Error Handling Values
'--------------------------------------------------------------------------------------
If Err_HandlerOn Then On Error GoTo xfn_StyleAdd_Error: Call SetErrObject(ERRSourceTitle) 'Ensure Custom Err Object is initialised
'------------------------------------------------------------------------------------------------------------------
xfn_StyleAdd_Code: strErrLabel = "xfn_StyleAdd_Code": strERRTitleWithLabel = ERRSourceTitle & "@" & strErrLabel ' Procedure Code below ----------------- xfn_StyleAdd_Code:
' --------------------------------------- Debug Code Above
Dim thisNewStyle As Style
booReturn = xfn_StyleExist(strNewStyle)
If Not booReturn Then
Set thisNewStyle = ActiveDocument.Styles.Add(Name:=strNewStyle, Type:=intStyleType , Linked:=False)
#If VBA7 Then
' thisNewStyle.Linked = False
#End If
End If
'-------------------------------------
GoTo xfn_StyleAdd_ExitFunction ' Skip to Exit
'------------------------------------- Error Handler Framework Dated 4.00 dated Saturday, 15Jan2011 00:47:14
xfn_StyleAdd_Error: ' Error handler
'------------------------------------- Mini-Error Handler Code V4.00 Dated Saturday, 15Jan2011 00:47:14
'-------------------------------------Full Error Handler Code V4.00 dated Saturday, 15Jan2011 00:47:14
ERR.AddDetails ThisProjectName, AA_Module__Name, strMacroName, strErrLabel, Erl, booErrorBreak
Select Case ERR.Number ' Requires Custom Error Object
Case Else 'Standard error no change
strTempErr = ERR.Description & vbCrLf & vbCrLf & _
"New Style Name: '" & strNewStyle & "'"
ERR.Restore: strTempErr = ERR.Description
ERR.Pop 'Remove highest stack instance before push
With ERR 'push and pop handled insed err.object
.Description = strTempErr: .ParameterA = ""
.BreakOnError = True: .ParameterB = ""
End With
End Select ' Case Err.Number
ERR.Push ' ------------------------------ After Amendments
Call GetErrDescr(ERR) ' set custom message and helpfile context (show error message from function)
ERR.Pop: If Not ERR.BreakOnError Then ERR.Clear: On Error GoTo xfn_StyleAdd_Error: Resume Next:
xfn_StyleAdd_ErrorCleanup: 'Cleanup for error crash
ERR.Clear: Call xfn_ErrorCleanup: End 'Generic Cleanup routine for host specific statements
Exit Function 'Future expansion to allow error to walk up the chain
'-----------------------------------------------------------------------
xfn_StyleAdd_ExitFunction: 'Single exit point for all jumps
xfn_StyleAdd = xfn_StyleExist(strNewStyle)
End Function ' End xfn_StyleAdd Function
Is this task possible using Word 2010?