View Single Post
 
Old 11-17-2022, 09:54 PM
Peterson Peterson is offline Windows 10 Office 2019
Competent Performer
 
Join Date: Jan 2017
Posts: 143
Peterson is on a distinguished road
Default

Try this:
Code:
Sub DOCXStylesDownload2()
' Copies styles from a template to the active document, then hides
' all styles that do not begin with an underscore
 
    Dim str_Source As String
    Dim str_Destination As String

    ''str_Source = "\\Server\Setup\OfficeTemplates\Automation.dotm"
    str_Destination = ActiveDocument.FullName
    
    On Error GoTo ErrorHandler
    
    Application.ScreenUpdating = False
    
    ' Pass source and destination paths to a function to copy styles:
    Call DOCXStyleCopy2(str_Source, str_Destination)
    ' Hide styles that don't begin with an underscore:
    Call DOCXHideStyles
    
    Application.ScreenUpdating = True
    
    Exit Sub

ErrorHandler:
    MsgBox "Error - StylesDownload2"

 End Sub


 Function DOCXStyleCopy2(strSource As String, strDestination As String)
' Loops through all styles in a document/template and copies them to a document
' if they begin with an underscore

    Dim myStyle As Style
    Dim objSourceDoc As Document
    
    On Error GoTo ErrorHandler
    
    ' Open the source document/template:
    Set objSourceDoc = Documents.Open(strSource, ReadOnly:=True)
    ' Loop through all the styles in the document/template:
    For Each myStyle In objSourceDoc.Styles
        ' If a style begins with an underscore:
        If InStr(myStyle.NameLocal, "_") = 1 Then
            '...then copy it to the source file:
            Application.OrganizerCopy Source:= _
            strSource, Destination:= _
            strDestination, Name:=myStyle.NameLocal, Object _
            :=wdOrganizerObjectStyles
        End If
    Next myStyle
    objSourceDoc.Close
    
Exit Function

ErrorHandler:
    MsgBox "Error StyleCopy2"

 End Function


 Function DOCXHideStyles()
' Hides all styles that do not begin with an underscore

    Dim myStyle As Style
    
    On Error GoTo ErrorHandler
    
    For Each myStyle In ActiveDocument.Styles
        ' If the style name doesn't begin with _, then hide it:
        If InStr(myStyle.NameLocal, "_") <> 1 Then
            ' Set visibility in the Styles pane:
            ' NOTE: The VBA setting to HIDE a style is ".Visibility = True" (thanks, Microsoft...):
            myStyle.Visibility = True
        End If
    Next myStyle

Exit Function

ErrorHandler:
    MsgBox "Error DOCXHideStyles"

End Function
Reply With Quote