Listes de validation capricieuses

Bonjour =E0 toutes et =E0 tous,

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

La finalit=E9 =E9tant d'avoir un fichier excel portant le nom du fichier =

word, comportant 6 colonnes =E0 renseigner dont 3 le seraient avec des=20
liste de choix. Ces choix =E9tant en page 2.

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

La cr=E9ation du nom des listes semble se faire correctement mais pourtan=
t=20
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=20
fichier excel (au point d'arr=EAt indiqu=E9 dans la macro), j'ai bien les=
3=20
noms de cr=E9=E9s pour les 3 plages, mais lorsque je s=E9lectionne chaque=
=20
plage, le nom n'apparait pas dans la zone de nom (en haut =E0 gauche).=20
Ceci explique peut =EAtre pourquoi les validations ne fonctionnent pas ap=
r=E8s.
En restant dans le fichier et en tentant de mettre manuellement les=20
validation en place =E0 partir des noms enregistr=E9s 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=E9cision : C'est excel et Word 2003.

Sub ouvrir_excel_new()

'R=E9cup=E9ration 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 =3D ActiveDocument.Path

stName =3D ActiveDocument.Name 'Pour r=E9cup=E9rer la valeur de stName
Pos =3D InStr(1, stName, ".", 1)
stName =3D Left(stName, Pos - 1)

NomClas =3D stName & ".xls"

Dim exl As Object

'...ouvre un nouveau classeur excel

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

'....enregistre le classeur

fichier =3D chemin & "\" & NomClas
ActiveWorkbook.SaveAs FileName:=3Dfichier

' Cr=E9e les titres des colonnes

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

Range("A2").Select

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

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

' C'est en mettant un point d'arr=EAt ici qu ej'ai pu faire les=20
constatations expliqu=E9es au d=E9but.

'Mise en place des listes de validation

exl.ActiveWorkbook.Sheets(1).Select

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

With exl.ActiveWorkbook.Sheets(1).Columns("E:E").Validation
.Add Type:=3DxlValidateList, AlertStyle:=3DxlValidAlertStop,=20
Operator:=3D _
xlBetween, Formula1:=3D"=3DListSexe"
.IgnoreBlank =3D True
.InCellDropdown =3D True
.InputTitle =3D ""
.ErrorTitle =3D ""
.InputMessage =3D ""
.ErrorMessage =3D ""
.ShowInput =3D True
.ShowError =3D True
End With

With exl.ActiveWorkbook.Sheets(1).Columns("F:F").Validation
.Add Type:=3DxlValidateList, AlertStyle:=3DxlValidAlertStop,=20
Operator:=3D _
xlBetween, Formula1:=3D"=3DListLieu"
.IgnoreBlank =3D True
.InCellDropdown =3D True
.InputTitle =3D ""
.ErrorTitle =3D ""
.InputMessage =3D ""
.ErrorMessage =3D ""
.ShowInput =3D True
.ShowError =3D True
End With

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

End Sub