![]() |
#2
|
||||
|
||||
![]()
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] |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Importing styles using Templates | Bikram | Word VBA | 2 | 08-31-2021 10:40 PM |
Getting rid of Styles and Templates confusion | John 4 | Word | 1 | 10-27-2020 07:25 AM |
Using Styles in Templates to help format text - Importing and working with Templates | daithy | Word | 2 | 01-03-2020 05:06 PM |
![]() |
Red Pill | Word | 3 | 06-12-2012 06:19 AM |
![]() |
rbilleaud | Word | 4 | 06-29-2011 05:51 PM |