Thread: Copying and then hiding all but a few "approved" styles into current document
View Single Post
 
Old 11-16-2022, 03:07 PM
andremadar andremadar is offline Windows 11 Office 2021
Novice
  
Join Date: Nov 2022
Location: United States
Posts: 1
andremadar is on a distinguished road
Question Copying and then hiding all but a few "approved" styles into current document
Hi! I've been tasked with creating some "official" styles our small law firm (24 attorneys) could use in a variety of documents. I'm self-taught with VBA so please forgive if some of my code looks like pure evil. I sure could use some additional brainpower!
  1. I have the 15 styles already created and stowed in a global template. The template downloads to Word's \STARTUP folder at user login.
  2. The user can run a macro in the global template that uses
    Code:
    Application.OrganizerCopy
    to download the styles into the current document. The macro that calls a small Function for each of the 15 styles is working, although a bit slow. Each style's name begins with the "_" character.

  3. After this fires, I'm enabling the little Style Pane with
    Code:
    Application.CommandBars("Styles").Position = msoBarRight
  4. Here's the problem: I'd like the Style Pane to hide all styles EXCEPT the official ones. But the macro recorder doesn't seem to capture much that goes on inside that window (e.g., marking each style as "Recommended" and so on), and googling hasn't turned up much.

Am I on the right track or am I doing things the hard way as usual...?

Code:
Sub DOCXStylesDownload2()

Dim str_Source As String
Dim str_Destination As String

str_Source = "\\Server\Setup\OfficeTemplates\Automation.dotm"
str_Destination = ActiveDocument.Path & "\" & ActiveDocument.Name

On Error GoTo ErrorHandler

Application.ScreenUpdating = False

Call DOCXStyleCopy2(str_Source, str_Destination, "_Body")
Call DOCXStyleCopy2(str_Source, str_Destination, "_BracketedNo")
Call DOCXStyleCopy2(str_Source, str_Destination, "_Claim")
Call DOCXStyleCopy2(str_Source, str_Destination, "_ClaimBody")
Call DOCXStyleCopy2(str_Source, str_Destination, "_DocTitle")
Call DOCXStyleCopy2(str_Source, str_Destination, "_EquationBody")
Call DOCXStyleCopy2(str_Source, str_Destination, "_EquationNo")
Call DOCXStyleCopy2(str_Source, str_Destination, "_Section")
Call DOCXStyleCopy2(str_Source, str_Destination, "_Section+Break")
Call DOCXStyleCopy2(str_Source, str_Destination, "_SectionSub")
Call DOCXStyleCopy2(str_Source, str_Destination, "_SectionSub+Break")
Call DOCXStyleCopy2(str_Source, str_Destination, "_Step")
Call DOCXStyleCopy2(str_Source, str_Destination, "_Table")
Call DOCXStyleCopy2(str_Source, str_Destination, "_Footer")
Call DOCXStyleCopy2(str_Source, str_Destination, "_Closing")

Application.ScreenUpdating = True

Exit Sub

ErrorHandler:
    MsgBox "Error"
    
End Sub
Function DOCXStyleCopy2(Source, Destination, StyleName As String)

On Error GoTo ErrorHandler

Application.OrganizerCopy Source:=Source, Destination:=Destination, Object:=wdOrganizerObjectStyles, Name:=StyleName

Exit Function

ErrorHandler:
    MsgBox "Error"
    
End Function
Reply With Quote