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
| Sub Generation_Fiches_traitements()
'
' Generation_Fiches_traitements Macro
' Macro enregistrée le 10/10/2010 par JLR
'
' Variables :
' Nombre de documents a generer
nbredoc = 4
' Prefixe utilise pour la generation du nom des doc
modeldoc = "AMA_PRD_appli_"
' repertoire ou les documents generes sont sauvegardes
dirdoc = "C:\Users\JLR\Documents\ARSOE\Generation de fiches - wrk\Livraison"
directoryimage = "C:\Documents and Settings\Jean-Luc RIVET\Mes documents\ARSOE\Generation de fiches - wrk\Fiches Chaines\Images Chaines\"
For i = 1 To nbredoc
'creation du document
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.MailAsAttachment = False
.MailAddressFieldName = ""
.MailSubject = ""
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
End With
.Execute Pause:=True
'definition du format du numero du traitement
End With
If i < 10 Then
i = "00000" & i
Else
If i < 100 Then
i = "0000" & i
Else
If i < 1000 Then
i = "000" & i
Else
If i < 10000 Then
i = "00" & i
Else
i = "0" & i
End If
End If
End If
End If
' definition du nom du document cree
file_name = modeldoc & i & ".doc"
' on cree le document dans le repertoire designe par dirdoc
ChangeFileOpenDirectory dirdoc
' Ajout de liens Hyperlink par recuperation du nom dans le doc
Selection.MoveDown Unit:=wdLine, Count:=6
Selection.MoveRight Unit:=wdCell
chaine_name = Selection.Text
chaine_adress = Selection.Text & ".doc"
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
chaine_adress, SubAddress:="", ScreenTip:="", TextToDisplay:= _
chaine_name
' Sauvegarde du document actif
ActiveDocument.SaveAs FileName:=file_name, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
' fermeture du document actif
ActiveWindow.Close
'passage au suivant
Next i
End Sub |
Partager