Discussion :

[David_R]

Bonjour à tous,

Je rencontre un souci majeur suite à la mise à jour du parc de Office 2003 à Office 2013.
Le modèle dont j'hérite utilise une macro (cf. ci-dessous) afin de pouvoir personnaliser le contenu du fichier word sur base de la liste des contacts du serveur Exchange.

Sous 2003, mes utilisateurs avaient deux valeurs identiques pour définir l'emplacement de leur modèle perso et celui du groupe;
Ce qui ne semblait pas poser de soucis. Je n'étais pas là non plus ...

Sous 2013; je me suis dit qu'il fallait mettre de l'ordre là dedans et ai donc scindé les deux emplacements,
le perso en local, emplacement par défaut
celui du groupe, sur un répertoire partagé (en lecture/ecriture) sur le serveur. (via disque mappé identique à tous)

Avec cette configuration, qui me semble plus propre,
j'obtiens le message d'erreur 'Le modèle n'a pas été trouvé dans les sous-répertoires modèles' tel que défini dans la macro. (ligne 73)

Si je repasse à la configuration 2003 (emplacements identiques), mon modèle s'alimente bien mais les utilisateurs obtiennent des messages d'erreurs lorsqu'ils tentent de quitter le modèle.
-> normal.dot, emailnormal.dot ....

J'ai fait pas mal de recherches et trouve plusieurs pistes, l'une d'elles serait de mettre le dossier partagé sur le serveur en lecture seule
mais cela ne résoudra pas mon souci si je souhaite utiliser deux emplacements distincts.

Entendu que le code ci-dessous ne me parle pas du tout ...
J'aurais souhaité l'avis d'un expert afin de l'adapter à mes besoins actuels.

En vous remerciant d'avance pour vos précieux conseils.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
Sub Princ()
' Version : 2.00
' Date Création : 29/4/2003
'
' Date modification : 06/09/2004
' Date modification : 13/09/2004 : Recherche du modèle dans les sous répertoire
' Date modification : 15/09/2004 : test qui cherche le modèle dans le rep principal
 
    On Error GoTo erreur
 
    Dim NomCplet As String
    Dim Soc As String
    Dim Titre As String
    Dim Nom As String
    Dim Prenom As String
    Dim Rue As String
    Dim Localité As String
    Dim CodePostal As String
    Dim Pays As String
    Dim Email As String
    Dim Utilisateur As String
    Dim datum As String
    Dim oContact As Outlook.ContactItem
    Dim fonction As String
    Dim Responsable As String 'service
    Dim Assistant As String
    Dim fonctionAss As String 'bureau
    Dim Dear As String 'Cher / chère mis dans suffix du nom
    Dim TelGest As String 'Ligne direct du gestionnaire
    Dim TelResp As String 'Ligne direct du responsable
 
    'Chargement des informations du contact en mémoire
    NomCplet = Application.GetAddress(addressproperties:="<PR_DISPLAY_NAME>", displayselectdialog:=1)
    datum = Format(Now(), "dddd d MMMM yyyy")
    Soc = Application.GetAddress(addressproperties:="<PR_COMPANY_NAME>", displayselectdialog:=2)
    'Monsieur, Madame qui se trouve dans le groupe de champs nom
    Titre = Application.GetAddress(addressproperties:="<PR_DISPLAY_NAME_PREFIX>", displayselectdialog:=2)
    'Titre = Application.GetAddress(AddressProperties:="<PR_TITLE>", displaySelectDialog:=2)
    Nom = Application.GetAddress(addressproperties:="<PR_GIVEN_NAME>", displayselectdialog:=2)
    Prenom = Application.GetAddress(addressproperties:="<PR_SURNAME>", displayselectdialog:=2)
    Rue = Application.GetAddress(addressproperties:="<PR_STREET_ADDRESS>", displayselectdialog:=2)
    Localité = Application.GetAddress(addressproperties:="<PR_LOCALITY>", displayselectdialog:=2)
    CodePostal = Trim(Application.GetAddress(addressproperties:="<PR_POSTAL_CODE>", displayselectdialog:=2))
    Pays = Application.GetAddress(addressproperties:="<PR_COUNTRY>", displayselectdialog:=2)
    Email = Application.GetAddress(addressproperties:="<PR_EMAIL_ADDRESS>", displayselectdialog:=2)
    'Utilisateur = Application.UserName
    'fonction = Application.UserAddress
    Responsable = Application.GetAddress(addressproperties:="<PR_DEPARTMENT_NAME>", displayselectdialog:=2)
    Assistant = Application.GetAddress(addressproperties:="<PR_ASSISTANT>", displayselectdialog:=2)
    fonctionAss = Application.GetAddress(addressproperties:="<PR_OFFICE_LOCATION>", displayselectdialog:=2)
    Dear = Application.GetAddress(addressproperties:="<PR_GENERATION>", displayselectdialog:=2)
    TelGest = Application.GetAddress(addressproperties:="<PR_RADIO_TELEPHONE_NUMBER>", displayselectdialog:=2)
    TelResp = Application.GetAddress(addressproperties:="<PR_CAR_TELEPHONE_NUMBER>", displayselectdialog:=2)
 
 
    'Ouverture de la feuille word
    Dim monDoc As New Document
    Dim suserTemplates As String
    Dim myRange As Range
    Dim Chemin As String
    Dim DocActif As Document
    Dim modele As String
    Dim chemModele As String
 
 
    Set DocActif = Application.ActiveDocument
    'Chemin par défaut des modèles de l'utilisateur
    Chemin = Options.DefaultFilePath(wdUserTemplatesPath)
    'Nom du modèle attaché au document courant
    modele = Application.ActiveDocument.AttachedTemplate
    chemModele = FindFile(Chemin, modele)
    If chemModele = "" Then
        MsgBox "Le modèle n'a pas été trouvé dans les sous-répertoires modèles "
        Exit Sub
    End If
 
    Set monDoc = Documents.Add(chemModele)
 
    Set myRange = monDoc.Content
 
    myRange.Find.Execute findtext:="Company", replacewith:=Soc, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Title", replacewith:=Titre, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Firstname", replacewith:=Nom, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Lastname", replacewith:=Prenom, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Street", replacewith:=Rue, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Locality", replacewith:=Trim(Localité), Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="PostalCode", replacewith:=Trim(CodePostal), Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Country", replacewith:=Pays, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="UserName", replacewith:=Utilisateur, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Fonction", replacewith:=fonction, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="MyEmail", replacewith:=Email, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Datum", replacewith:=datum, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Assist", replacewith:=Assistant, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="FctAss", replacewith:=fonctionAss, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="ManagerName", replacewith:=Responsable, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="Dear", replacewith:=Dear, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="TelGest", replacewith:=TelGest, Replace:=wdReplaceAll
    myRange.Find.Execute findtext:="TelResp", replacewith:=TelResp, Replace:=wdReplaceAll
 
    'Il faut Définir un bookmark dans le document qui porte le nom curseur pour se positionner
    'automatiquement dessus lors de la création d'un nouveau document
    If (monDoc.Bookmarks.Exists("curseur")) Then
        monDoc.Bookmarks("Curseur").Select
    End If
    'Test la longueur des champs et affiche un message si trop grand
    If Len(Rue) > 45 Then
        MsgBox ("Attention la longueur de l'adresse risque de provoquer un saut de ligne")
    End If
 
    If Len(Localité) > 35 Then
        MsgBox ("Attention la longueur de la localité risque de provoquer un saut de ligne")
    End If
    'monDoc.SaveAs FileName:="NouveauNom.doc", fileFormat:=wdFormatDocument
    DocActif.Close
    Set monDoc = Nothing
    Set DocActif = Nothing
    Set myRange = Nothing
 
Sortie:
    Exit Sub
 
erreur:
    MsgBox Err.Description
    Resume Sortie
End Sub
 
Function FindFile(sPath As String, sFile As String) As String
    'Recherche le chemin du modèle du document courant
    'on connait le chemin par défaut et le nom du modèle
    'on doit rechercher dans les sous répertoires du répertoire par défaut des modèles
    Dim sFileName As String
    Dim Directories() As String
    Dim i As Integer
 
    ReDim Directories(0)
    'Ajout du backslash si il manque
    If Right(sPath, 1) <> Application.PathSeparator Then
        sPath = sPath & Application.PathSeparator
    End If
    sFileName = Dir(sPath, vbDirectory)
    'lit les sous répertoires et les mets dans un tableau
    Do While sFileName <> ""
        If GetAttr(sPath & sFileName) And vbDirectory Then
            If sFileName <> "." And sFileName <> ".." Then
                i = UBound(Directories)
                Directories(UBound(Directories)) = sPath & sFileName
                ReDim Preserve Directories(UBound(Directories) + 1)
            End If
        End If
        sFileName = Dir
    Loop
 
    'Test de la présence du fichier dans les sous répertoire
    i = 0
    sFileName = Dir(Directories(0) & sFile)
    Do While i <= UBound(Directories()) - 1
        If sFileName <> "" Then
            FindFile = Directories(i) & "\" & sFile
            Exit Function
        End If
        i = i + 1
        sFileName = Dir(Directories(i) & "\" & sFile)
    Loop
 
    If Dir(sPath & sFile) <> "" Then
        FindFile = sPath & sFile
    Else
        FindFile = ""
    End If
 
End Function

[Heureux-oli]

Salut,

L'erreur liée à la ligne 73 va se produire si l'utilisateur utlise un modèle de groupe.

En fait, on recherche dans le répertoire de l'utilisateur un modèle qui devrait se trouver sur le réseau pour le groupe.

[David_R]

Bonjour,
Je te remercie et te confirme que j'obtiens le message uniquement si le dossier local ne pointe pas vers le répertoire partagé.

Je dois donc définir tant le dossier local que le dossier partagé vers l'hébergement partagé pour ne pas avoir de message d'erreur à l'ouverture du modèle;
mais cela génère les messages repris plus haut.

Aurais tu une solution pour me permettre de maintenir les modèles locaux en local
et rendre mes modèles partagés fonctionnels ?

Merci

[Heureux-oli]

Salut,

Je ne comprend pas l'intérêt de ce test.
On peut probablement s'en passer.

[David_R]

Bonjour à tous, je pense avoir trouvé la solution me permettant de scinder les modèles de l'utilisateur et ceux du workgroup
tout en pouvant utiliser cette macro :

Je devrais adapter la ligne 68

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Chemin = Options.DefaultFilePath(wdUserTemplatesPath)

par ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Chemin = Options.DefaultFilePath(wdWorkgroupTemplatesPath)

J'ai fait le test avec un modèle et pas de soucis.

Le problème étant maintenant de trouver une solution pour modifier en masse cette macto présente dans plus de 200 modèles ...

Merci pour vos retours,

[Heureux-oli]

Salut,

Tu peux trouver un début de solution là : http://silkyroad.developpez.com/VBA/VisualBasicEditor/