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 |
