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
|
Sub MAJ_Liaison()
Dim alink As Field, linktype As Range, linkfile As Range
Dim linklocation As Range, i As Integer, j As Integer, linkcode As Range
Dim Message, Title, Default, Newfile
Dim counter As Integer
'Nom1 = Application.ActiveDocument.Name
'Nom1 = Mid(Nom1, 1, 4)
'Crée une fenetre d'acces vers fichier excel pour définir le fichier
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
'Définie la boite de dialogue excel ouvrir
Set objExcel = Application.FileDialog(msoFileDialogFilePicker)
With objExcel
If .Show = -1 Then
For Each Source In .SelectedItems
chemin = Source
Temp = Replace(chemin, "\", "\\")
chemin = Replace(Temp, "W:", "\\\\Sntp0350\\Travail")
If chemin Like "*2011*" Then
Nom1 = "2011"
ElseIf chemin Like "*2012*" Then
Nom1 = "2012"
End If
'chemin = "\\\\Sntp0350\\Travail" & Temp
Next Source
End If
End With
'Décompose et recompse le lien des liaisons
counter = 0
For Each alink In ActiveDocument.Fields
If alink.Type = wdFieldLink Then
Set linkcode = alink.Code
i = InStr(linkcode, Chr(34))
Set linktype = alink.Code
linktype.End = linktype.Start + i
j = InStr(Mid(linkcode, i + 1), Chr(34))
Set linklocation = alink.Code
linklocation.Start = linklocation.Start + i + j - 1
If linklocation Like "*2011*" Then
Nom2 = "2011"
ElseIf linklocation Like "*2012*" Then
Nom2 = "2012"
End If
linklocation = Replace(linklocation, Nom2, Nom1)
If counter = 0 Then
Set linkfile = alink.Code
linkfile.End = linkfile.Start + i + j - 1
linkfile.Start = linkfile.Start + i
Message = "Veuillez confirmer le nouveau chemin pour les liaisons "
Format " & linkfile "
Title = "Update Lien"
Default = chemin
Newfile = InputBox(Message, Title, Default)
End If
linkcode.Text = linktype & Newfile & linklocation
counter = counter + 1
End If
Next alink
End Sub |
Partager