Convertir xlsm en xlsx

Bonjour,

je veux convertir plusieurs classeurs xlsm en xlsx.

Tout se passe bien sauf qu'en sortie le fichier ne retire pas le . xlsm et se nomme

Fichier.xlsm.xlsx

Sub Pour_FAB()
Dim Chemin As String
Dim Fichier As String
Dim i As Long

Application.DisplayAlerts = False
Chemin = ThisWorkbook.Path & "\FAB\"
Fichier = Dir(Chemin & "*.xlsm")
Do While Fichier <> ""
For i = 1 To Sheets.Count
Workbooks.Open Filename:=Chemin & Fichier
   ActiveWorkbook.SaveAs Filename:=Chemin & ActiveWorkbook.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False  'renommer
ActiveWorkbook.Close
Fichier = Dir
Next i
Loop
Application.DisplayAlerts = True
End Sub

Si quelqu'un a une idée.

Bonne journée

bonjour,

à tester

Sub Pour_FAB()
Dim Chemin As String
Dim Fichier As String
Dim i As Long

Application.DisplayAlerts = False
'Chemin = ThisWorkbook.Path & "\FAB\"
Fichier = Dir(Chemin & "*.xlsm")
Do While Fichier <> ""
For i = 1 To Sheets.Count
Workbooks.Open Filename:=Chemin & Fichier
newname = Replace(ActiveWorkbook.Name, ".xlsm", "")

   ActiveWorkbook.SaveAs Filename:=Chemin & newname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False  'renommer
ActiveWorkbook.Close
Fichier = Dir
Next i
Loop
Application.DisplayAlerts = True
End Sub

C'est ok.

Merci encore h2so4

Passe une bonne fin de week end