Listes de validation capricieuses

Bonjour à toutes et à tous,

A partir d'un fichier word [j'ai bien vu que c'est le forum excel ;-)],
je souhaite créer un fichier excel avec la macro ci-dessous.

La finalité étant d'avoir un fichier excel portant le nom du fichier =

word, comportant 6 colonnes à renseigner dont 3 le seraient avec des
liste de choix. Ces choix étant en page 2.

L'ouverture d'excel, la création du fichier, son enregistrement, le
titrage des colonnes, l'écriture des choix (en seconde page) ; tout cel=
a
fonctionne et se déroule parfaitement.

La création du nom des listes semble se faire correctement mais pourtan=
t
je ne suis pas certain que cela se fasse comme il faut car avant la mise =

en place des validations (qui ne fonctionnent pas), si je vais dans le
fichier excel (au point d'arrêt indiqué dans la macro), j'ai bien les=
3
noms de créés pour les 3 plages, mais lorsque je sélectionne chaque=

plage, le nom n'apparait pas dans la zone de nom (en haut à gauche).
Ceci explique peut être pourquoi les validations ne fonctionnent pas ap=
rès.
En restant dans le fichier et en tentant de mettre manuellement les
validation en place à partir des noms enregistrés pour les plages de =

choix, il y a une erreur de source corrompue.

L'un ou l'une d'entre vous pourrait-il me venir en aide ?
merci d'avance.

Daniel

Précision : C'est excel et Word 2003.

Sub ouvrir_excel_new()

'Récupération du nom par le nom du fichier word
Dim stName As String
Dim NomClas As String
Dim chemin As String
Dim fichier As String

chemin = ActiveDocument.Path

stName = ActiveDocument.Name 'Pour récupérer la valeur de stName
Pos = InStr(1, stName, ".", 1)
stName = Left(stName, Pos - 1)

NomClas = stName & ".xls"

Dim exl As Object

'ouvre un nouveau classeur excel

Set exl = CreateObject("excel.application")
exl.Visible = True
exl.Workbooks.Add

'.enregistre le classeur

fichier = chemin & "" & NomClas
ActiveWorkbook.SaveAs FileName:=fichier

' Crée les titres des colonnes

exl.ActiveWorkbook.Sheets(1).Cells(1) = " Nom "
exl.ActiveWorkbook.Sheets(1).Cells(2) = " Prénom "
exl.ActiveWorkbook.Sheets(1).Cells(3) = " Fonction "
exl.ActiveWorkbook.Sheets(1).Cells(4) = " J/A (Jeune ou Adulte)"
exl.ActiveWorkbook.Sheets(1).Cells(5) = " H/F "
exl.ActiveWorkbook.Sheets(1).Cells(6) = " Int/Ext"

Range("A2").Select

'.création listes de choix (à finir)
exl.ActiveWorkbook.Sheets(2).Range("A1") = "J"
exl.ActiveWorkbook.Sheets(2).Range("A2") = "A"
exl.ActiveWorkbook.Sheets(2).Range("B1") = "H"
exl.ActiveWorkbook.Sheets(2).Range("B2") = "F"
exl.ActiveWorkbook.Sheets(2).Range("C1") = "Int"
exl.ActiveWorkbook.Sheets(2).Range("C2") = "Ext"

'.nomination des listes de choix
With exl.ActiveWorkbook.Sheets(2)
Range("A1:A2").Select
ActiveWorkbook.Names.Add Name:="ListAge", RefersToR1C1:= _
"=Feuil2!R1C1:R2C1"
Range("B1:B2").Select
ActiveWorkbook.Names.Add Name:="ListSexe", RefersToR1C1:= _
"=Feuil2!R1C2:R2C2"
Range("C1:C2").Select
ActiveWorkbook.Names.Add Name:="ListLieu", RefersToR1C1:= _
"=Feuil2!R1C3:R2C3"
End With

' C'est en mettant un point d'arrêt ici qu ej'ai pu faire les
constatations expliquées au début.

'Mise en place des listes de validation

exl.ActiveWorkbook.Sheets(1).Select

With exl.ActiveWorkbook.Sheets(1).Columns("D:D").Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="=ListAge"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

With exl.ActiveWorkbook.Sheets(1).Columns("E:E").Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="=ListSexe"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

With exl.ActiveWorkbook.Sheets(1).Columns("F:F").Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="=ListLieu"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

exl.ActiveWorkbook.Sheets(1).Range("A2").Select

End Sub