View Single Post
 
Old 06-12-2022, 07:04 AM
macropod's Avatar
macropod macropod is offline Windows 10 Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Perhaps:
Code:
Sub AddStyles()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, Stl As Style, StrStls As String, i As Long
StrStls = "|"
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the source document containing the required Styles"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocSrc = Documents.Open(.SelectedItems(1), ReadOnly:=True, AddToRecentFiles:=False)
  Else
    MsgBox "No source file selected. Exiting", vbExclamation
    Exit Sub
  End If
End With
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the document to be updated"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocTgt = Documents.Open(.SelectedItems(1), ReadOnly:=False, AddToRecentFiles:=True)
  Else
    MsgBox "No target file selected. Exiting", vbExclamation
    DocSrc.Close SaveChanges:=False
    Set DocSrc = Nothing
    Exit Sub
  End If
End With
For Each Stl In DocSrc.Styles
  If Stl.BuiltIn = False Then StrStls = StrStls & Stl.NameLocal & "|"
Next
For Each Stl In DocTgt.Styles
  If Stl.BuiltIn = False Then StrStls = Replace(StrStls, "|" & Stl.NameLocal & "|", "|")
Next
For i = 1 To UBound(Split(StrStls, "|")) - 1
  Application.OrganizerCopy Source:=DocSrc.Fullname, Destination:=DocTgt.Fullname, Name:=Split(StrStls, "|")(i), Object:=wdOrganizerObjectStyles
Next
DocTgt.Close SaveChanges:=True: DocSrc.Close SaveChanges:=False
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
MsgBox "Successfully added missing Styles"
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote