Private Sub CmdTarget_Click()
'Create a FileDialog object as a File Picker dialog box.
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Filters.Clear
  .AllowMultiSelect = True
  .Filters.Add "All Word Documents", "*.doc; *.dot; *.rtf; *.docx; *.docm; *.dotx; *.dotm", 1
  If .Show = -1 Then
    'clicked OK
    TargetFile = .SelectedItems(1) 'get selected path, file name and extension for source
    With ListBox3
      .ColumnCount = 2
      .ColumnWidths = "0; 60"
    End With
    For Each TargetFile In .SelectedItems
      TargetFile = WordBasic.FileNameInfo$(TargetFile, 2) 'gets new filename
      TargetFilename = WordBasic.FileNameInfo$(TargetFile, 1) 'gets new filename and path
      ListBox3.AddItem (TargetFilename)
      ListBox3.Column(1, ListBox3.ListCount - 1) = TargetFile
      CountTargetFiles = CountTargetFiles + 1
      lblTargetCount.Caption = "(" & CountTargetFiles & ")"
    Next
  End If
End With
' Else
'user canceled
Exit Sub
End Sub

Private Sub CmdCopyStyle_Click()
Dim SourceDoc As String
Dim styleNames() As Variant
Dim DestDocs() As Variant
Dim x As Long
Dim y As Long
ReDim styleNames(ListBox2.ListCount - 1)
styleNames() = Me.ListBox2.List
DestDocs() = Me.ListBox3.Column(0)
For x = 0 To UBound(DestDocs)
  For y = 0 To UBound(styleNames)
    Application.OrganizerCopy _
      Source:=SourceFile, _
      Destination:=DestDocs(x), _
      Name:=styleNames(y), _
      Object:=wdOrganizerObjectStyles
  Next y
Next x
End Sub

Private Sub CmdTarget_Click()
Dim TargetFile As Variant, i As Long
'Create a FileDialog object as a File Picker dialog box.
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Filters.Clear
  .Filters.Add "All Word Documents", "*.doc; *.dot; *.rtf; *.docx; *.docm; *.dotx; *.dotm", 1
  .AllowMultiSelect = True
  If .Show = -1 Then
    ' User clicked OK
    With ListBox3
      .ColumnCount = 2
      .ColumnWidths = "0; 60"
    End With
    ' Populate the listbox
    For Each TargetFile In .SelectedItems
      ListBox3.AddItem (TargetFile)
      ListBox3.Column(1, i) = Split(TargetFile, "\")(UBound(Split(TargetFile, "\"))) 'gets the filename
      i = i + 1
    Next
    ' Report the file count
    lblTargetCount.Caption = "(" & .SelectedItems.Count & ")"
  Else
    ' User clicked Cancel
    Exit Sub
  End If
End With
End Sub

Sub Demo()
Dim i As Long
With ListBox3
  For i = 0 To .ListCount - 1
    MsgBox .Column(0, i)
  Next
End With
End Sub

Private Sub CmdCopyStyle_Click()
Dim DestDoc As String, x As Long, y As Long
For x = 0 To ListBox3.listcount - 1
  DestDoc = ListBox3.Column(0, x)
  For y = 0 To ListBox2.listcount - 1
    Application.OrganizerCopy Source:=SourceFile, Destination:=DestDoc, _
      Name:=ListBox2.Column(0, y), Object:=wdOrganizerObjectStyles
  Next y
Next x
End Sub

For Each aStyle In ActiveDocument.Styles
  If aStyle.BuiltIn = False Then
    ListBox1.AddItem (aStyle)
    CountSourceStyles = CountSourceStyles + 1
    lblSourceCount.Caption = "(" & CountSourceStyles & ")"
  End If
Next aStyle

1 / 1.1 / 1.1.1
1 / a / i
Article / Section
Comment Reference
Emphasis
Endnote Reference
FollowedHyperlink
Footnote Reference
HTML Acronym
HTML Cite
HTML Code
HTML Definition
HTML Keyboard
HTML Sample
HTML Typewriter
HTML Variable
Hyperlink
Line Number
Page Number
Strong
Table 3D effects 1
Table 3D effects 2
Table 3D effects 3
Table Classic 1
Table Classic 2
Table Classic 3
Table Classic 4
Table Colorful 1
Table Colorful 2
Table Colorful 3
Table Columns 1
Table Columns 2
Table Columns 3
Table Columns 4
Table Columns 5
Table Contemporary
Table Elegant
Table Grid
Table Grid 1
Table Grid 2
Table Grid 3
Table Grid 4
Table Grid 5
Table Grid 6
Table Grid 7
Table Grid 8
Table List 1
Table List 2
Table List 3
Table List 4
Table List 5
Table List 6
Table List 7
Table List 8
Table Professional
Table Simple 1
Table Simple 2
Table Simple 3
Table Subtle 1
Table Subtle 2
Table Theme
Table Web 1
Table Web 2
Table Web 3

Private Sub CmdCopyStyle_Click()
Dim DestDoc As String, x As Long, y As Long, StrSty As String, StrList As String
For x = 0 To ListBox3.ListCount - 1
  DestDoc = ListBox3.Column(0, x)
  For y = ListBox2.ListCount - 1 To 0 Step -1
    StrSty = ListBox2.Column(0, y)
    On Error Resume Next
    Application.OrganizerCopy Source:=SourceFile, Destination:=DestDoc, _
      Name:=StrSty, Object:=wdOrganizerObjectStyles
    If Err.Number = 4198 Then
      If x = 0 Then StrList = vbCr & StrSty & StrList
      ListBox2.RemoveItem (y)
    End If
    Err.Clear
  Next y
Next x
If StrList <> "" Then MsgBox "Unable to copy the following Styles:" & StrList
End Sub