Copying specific styles

[Parthiban G]

Dear Mr. Andreas,

You can use the following code to do what you have asked.


Dim sDocStyles As String

Sub CopyStyles()

Dim oStyle As Style
Dim sPrefix As String
Dim oSrcDoc As Document, oTemplate As Document

Set oSrcDoc = ActiveDocument

Call GetDocStyles

Documents.Open FileName:=ActiveDocument.AttachedTemplate.FullName, ReadOnly:=True
Set oTemplate = ActiveDocument

sPrefix = "Diss_"

For Each oStyle In oTemplate.Styles
If Left(oStyle.NameLocal, Len(sPrefix)) = sPrefix And oStyle.BuiltIn = False Then

If InStr(1, sDocStyles, "|" & oStyle.NameLocal & "|", vbBinaryCompare) <> 0 Then
ActiveDocument.Styles(oStyle.NameLocal).Delete
End If

Application.OrganizerCopy Source:=oTemplate.FullName, _
Destination:=oSrcDoc.FullName, Name:=oStyle.NameLocal, _
Object:=wdOrganizerObjectStyles
End If
Next oStyle

oTemplate.Close wdDoNotSaveChanges

MsgBox "Styles are copied successfully!", vbInformation, "Dear Andreas"

End Sub

'Gets the list of styles available in the document
Public Sub GetDocStyles()

Dim iStylIdx As Integer

sDocStyles = "|"

For iStylIdx = 1 To ActiveDocument.Styles.Count
sDocStyles = sDocStyles & ActiveDocument.Styles(iStylIdx).NameLocal & "|"
Next iStylIdx

If sDocStyles = "|" Then sDocStyles = ""

End Sub


I have created a ready-made template for you, but, this site don't have any features to send the files. So, i couldn't send you.. sorry buddy..


Thanks,
parthiban,India

 

[andreas]

Dear Mr. Andreas,

You can use the following code to do what you have asked.

Dim sDocStyles As String

Sub CopyStyles()

    Dim oStyle As Style
    Dim sPrefix As String
    Dim oSrcDoc As Document, oTemplate As Document

   Set oSrcDoc = ActiveDocument

   Call GetDocStyles

   Documents.Open FileName:=ActiveDocument.AttachedTemplate.FullName, ReadOnly:=True
   Set oTemplate = ActiveDocument

    sPrefix = "Diss_"

    For Each oStyle In oTemplate.Styles
        If Left(oStyle.NameLocal, Len(sPrefix)) = sPrefix And oStyle.BuiltIn = False Then

            If InStr(1, sDocStyles, "|" & oStyle.NameLocal & "|", vbBinaryCompare) <> 0 Then
                ActiveDocument.Styles(oStyle.NameLocal).Delete
             End If

            Application.OrganizerCopy Source:=oTemplate.FullName, _
            Destination:=oSrcDoc.FullName, Name:=oStyle.NameLocal, _
            Object:=wdOrganizerObjectStyles
        End If
    Next oStyle

    oTemplate.Close wdDoNotSaveChanges

    MsgBox "Styles are copied successfully!", vbInformation, "Dear Andreas"

End Sub

'Gets the list of styles available in the document
Public Sub GetDocStyles()

    Dim iStylIdx As Integer

    sDocStyles = "|"

    For iStylIdx = 1 To ActiveDocument.Styles.Count
        sDocStyles = sDocStyles & ActiveDocument.Styles(iStylIdx).NameLocal & "|"
    Next iStylIdx

    If sDocStyles = "|" Then sDocStyles = ""

End Sub

I have created a ready-made template for you, but, this site don't have any features to send the files. So, i couldn't send you.. sorry buddy..

Thanks,
parthiban,India

Hey parthiban,

thank you for your code. Since your message was not posted under the
initial question of mine, I only found your solution by chance.
Anyway, will test it in the coming days and let you know.

thank you very much. Regards, Andeas

 

[andreas]

Dear Mr. Andreas,

You can use the following code to do what you have asked.

Dim sDocStyles As String

Sub CopyStyles()

    Dim oStyle As Style
    Dim sPrefix As String
    Dim oSrcDoc As Document, oTemplate As Document

   Set oSrcDoc = ActiveDocument

   Call GetDocStyles

   Documents.Open FileName:=ActiveDocument.AttachedTemplate.FullName, ReadOnly:=True
   Set oTemplate = ActiveDocument

    sPrefix = "Diss_"

    For Each oStyle In oTemplate.Styles
        If Left(oStyle.NameLocal, Len(sPrefix)) = sPrefix And oStyle.BuiltIn = False Then

            If InStr(1, sDocStyles, "|" & oStyle.NameLocal & "|", vbBinaryCompare) <> 0 Then
                ActiveDocument.Styles(oStyle.NameLocal).Delete
             End If

            Application.OrganizerCopy Source:=oTemplate.FullName, _
            Destination:=oSrcDoc.FullName, Name:=oStyle.NameLocal, _
            Object:=wdOrganizerObjectStyles
        End If
    Next oStyle

    oTemplate.Close wdDoNotSaveChanges

    MsgBox "Styles are copied successfully!", vbInformation, "Dear Andreas"

End Sub

'Gets the list of styles available in the document
Public Sub GetDocStyles()

    Dim iStylIdx As Integer

    sDocStyles = "|"

    For iStylIdx = 1 To ActiveDocument.Styles.Count
        sDocStyles = sDocStyles & ActiveDocument.Styles(iStylIdx).NameLocal & "|"
    Next iStylIdx

    If sDocStyles = "|" Then sDocStyles = ""

End Sub

I have created a ready-made template for you, but, this site don't have any features to send the files. So, i couldn't send you.. sorry buddy..

Thanks,
parthiban,India

Hey Parthiban,

thank you very much for the code. I tried it. It is working as
desired. Great Job. Thank you very much. Regards, Andreas