Re : Comment conserver les macros après avoir fusionné un document.
VOICI LA macro que j'utilise.
Dim W_NomDoc As String
Private Sub Document_Open()
Fusion
End Sub
Sub Fusion()
'
' Fusion Macro
' Ouverture de la source de données qui à le même nom que le fichier
'Dim W_NomDoc As String
W_NomDoc = Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 4)
ActiveDocument.MailMerge.OpenDataSource Name:= _
ThisDocument.Path & "\" & W_NomDoc & ".txt", ConfirmConversions:=False, ReadOnly _
:=False, LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:= _
"", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:="", SQLStatement:="", SQLStatement1:=""
'Exécution de la fusion word
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.MailAsAttachment = True
.MailAddressFieldName = ""
.MailSubject = ""
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=True
End With
Call Macro2
End Sub
Sub Macro2()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "|"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Protect (wdAllowOnlyFormFields)
End Sub
et ma 2ème macro qui est sur un bouton.
Function RepertoireExiste(Chemin As String) As Boolean
On Error Resume Next
RepertoireExiste = GetAttr(Chemin) And vbDirectory
End Function
Private Sub CommandButton1_Click()
W_NomDoc = Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 4)
ActiveDocument.MailMerge.OpenDataSource Name:= _
ThisDocument.Path & "\" & W_NomDoc & ".txt", ConfirmConversions:=False, ReadOnly _
:=False, LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:= _
"", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:="", SQLStatement:="", SQLStatement1:=""
Dim Chemin As String, NomRep As String, NomDossier As String, Code As String, Nom As String, Prénom As String
Chemin = "J:\Documents de suivi\test\NomDossier"
NomRep = Dir(Chemin, vbDirectory)
Code = ActiveDocument.MailMerge.DataSource.DataFields(1).Value
Nom = ActiveDocument.MailMerge.DataSource.DataFields(2).Value
Prénom = ActiveDocument.MailMerge.DataSource.DataFields(3).Value
NomDossier = ActiveDocument.MailMerge.DataSource.DataFields(2).Value & " " & ActiveDocument.MailMerge.DataSource.DataFields(3).Value & " " & ActiveDocument.MailMerge.DataSource.DataFields(1).Value
If RepertoireExiste("J:\Documents de suivi\test\" & NomDossier) Then
Call ChangeFileOpenDirectory("J:\Documents de suivi\test\" & NomDossier)
Else
MkDir "J:\Documents de suivi\test\" & NomDossier
MsgBox "le dossier est créé"
End If
Call ChangeFileOpenDirectory("J:\Documents de suivi\test\" & NomDossier)
ActiveDocument.SaveAs FileName:="nom du document" & " " & Nom & " " & Prénom & " " & Code & " " & Format(Now, "dd mmmm yyyy") & " " & Format(n + 1, "000") & ".doc"
End Sub
la macro fonctionne correctement lorsque je la lance du document d'origine, mais lorsque la fusion est faite, les macros ne sont pas dupliquées sur le document fusionné donc le bouton est bien présent, mais ne fonctionne pas