1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
| Private Sub Document_Open()
' Macro enregistrée le 02/07/2007 par Nicolas BAUDRY
'
'cela permet de faire la fusion du publipostage en automatique dès l'ouverture du fichier word relié à la base de données
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
.LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
End With
.Execute Pause:=False
End With
nomfich = Word.ActiveDocument.Name
' Message pour l'utilisateur
Msg = "Voulez-vous enregistrer le CB " & vbCrLf & "Cliquez sur 'Oui' pour enregistrer" ' Définit le message.
Style = vbYesNo + vbQuestion ' Définit les boutons.
Title = "Demande d'enregistrement" ' Définit le titre.
Response = MsgBox(Msg, Style, Title) ' Affiche le message.
If Response = vbYes Then ' L'utilisateur a choisi Oui.
'Je recherche le champ "lot" se trouvant juste derrière les caractères "Lot N° "
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
.Execute FindText:="Lot n° "
End With
' Je sélectionne le champ "lot"
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Lot = Selection
'Idem pour le champ "nom"
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
.Execute FindText:="ORIGINE"
End With
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Nom = Selection
Selection.MoveDown Unit:=wdLine, Count:=1
'Je précise que le nom du fichier se nommera sous cette forme
Fichier = (Nom & "_" & Lot)
'Je précise la localisation de l'enregistrement et le nom sous lequel il doit être enregistré
ChangeFileOpenDirectory "\\Serveur-caill\Documents\temporaire\Nicolas\Recherche_BA\Famille\CB_créé"
'ChangeFileOpenDirectory "\\Serveur-caill\Documents\Contrôles botaniques"
ActiveDocument.SaveAs FileName:=Fichier, FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
'
'Je confirme à l'utilisateur l'enregistrement
MsgBox ("Le fichier " & Fichier & ".doc a bien été enregistré dans le répertoire" & vbCrLf & "\\Serveur-caill\Documents\temporaire\Nicolas\Recherche_BA\Famille\CB_Créé")
Else
End If
'End If
'Je ferme le fichier word de base d'où a été lancé le publipostage pour rester uniquement sur le fichier nouvellement créé et nommé
Documents("CB_Famille.doc").Activate
Documents("CB_Famille.doc").Close False
End Sub |
Partager