XL 2016 Bug macro sur boucle FOR EACH depuis MAJ Office

Function suppAccent(chaine As String) As String

    Dim accent As String, sansAccent As String, i As Long
    accent = "áàâäãåéèêëíìîïóòôöõðúùûüÿýçÀÁÂÃÄÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜ()-_/\+-*~'"
    sansAccent = "aaaaaaeeeeiiiioooooouuuuyycaaaaaeeeeiiiiooooouuuu           "
    For i = 1 To Len(accent)
        chaine = Replace(chaine, Mid(accent, i, 1), Mid(sansAccent, i, 1))
    Next i
    suppAccent = chaine
End Function

'...au dessus le reste de ton code
Dim Cel As Range, Plage As Range, x As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each x In ActiveSheet.UsedRange
If TypeName(x.Value) = "String" Then
x.Value = suppAccent(x.Text)
End If
Next
Columns("A:C").ColumnWidth = 30: Columns("D:D").ColumnWidth = 10
Columns("E:E").ColumnWidth = 25: Columns("F:F").ColumnWidth = 2
Application.ScreenUpdating = True
Application.EnableEvents = True
'...  en dessous le reste de ton code

Function suppAccent(chaine As String) As String
Dim accent$, sansAccent$, i&
accent = "áàâäãåéèêëíìîïóòôöõðúùûüÿýçÀÁÂÃÄÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜ()-_/\+-*~'"
sansAccent = "aaaaaaeeeeiiiioooooouuuuyycaaaaaeeeeiiiiooooouuuu           "
For i = 1 To Len(accent)
chaine = Replace(chaine, Mid(accent, i, 1), Mid(sansAccent, i, 1))
Next i
suppAccent = VBA.UCase(chaine)
End Function

chaine = Replace(chaine, Mid(accent, i, 1), Mid(sansAccent, i, 1))
Next i

ChDrive "C"
ChDir "C:\"
NewName = "TEST.prn" '

nmFichier = "TEST"
nmFichierSauvé = Application.GetSaveAsFilename(nmFichier, _
"Texte (séparateur: espace) (*.prn), *.prn", , _
"Export de fichiers texte")

idFichier = FreeFile()

Open nmFichierSauvé For Output As #idFichier

nbLignes = Selection.Rows.Count
nbColonnes = Selection.Columns.Count

For iLigne = 1 To nbLignes
For iColonne = 1 To nbColonnes
With Selection.Cells(iLigne, iColonne)

largCellule = Application.Round(.ColumnWidth, 0)

txtCellule = .Text

If Len(txtCellule) < largCellule Then
   Select Case .HorizontalAlignment
      Case xlGeneral, xlFill
      If Application.IsNumber(.Value) Then
         txtCellule = String(largCellule - Len(txtCellule), " ") & txtCellule
      Else
         txtCellule = txtCellule & _
         String(largCellule - Len(txtCellule), " ")
      End If
      Case xlLeft, xlJustify
      txtCellule = txtCellule & _
      String(largCellule - Len(txtCellule), " ")
   End Select
Else
   txtCellule = Left(txtCellule, largCellule)
End If

End With

Print #idFichier, txtCellule;

Next iColonne

If iLigne <> nbLignes Then Print #idFichier, ""

Next iLigne

Close #idFichier

On Error Resume Next
Kill "C:\TEST.txt"

Name "C:\TEST.prn" As "C:\TEST.txt"

Sub Export_TXT()
Dim fic_TXT
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.Copy
fic_TXT = Application.GetSaveAsFilename(fileFilter:="FICHIER TEXTE (*.txt), *.txt")
ActiveWorkbook.SaveAs Filename:=fic_TXT, FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Close False
End Sub

Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer)
'source:mark007|xpress|(nb)759
    Dim i&, j&, fNum&, strLine$, strCell$
    fNum = FreeFile
     'open the textfile
    Open strFile For Output As fNum
     'loop from first to last row
     'use 2 rather than 1 to ignore header row
    For i = 1 To ws.Range("A65536").End(xlUp).Row
         'new line
        strLine = ""
         'loop through each field
        For j = 0 To UBound(s)
             'make sure we only take chars up to length of field (may want to output some sort of error if it is longer than field)
            strCell = Left$(ws.Cells(i, j + 1).Value, s(j))
             'add on string of spaces with length equal to the difference in length between field length and value length
            strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32))
        Next j
         'write the line to the file
        Print #fNum, strLine
    Next i
     'close the file
    Close #fNum
End Sub
 
Sub CreateFile()
    Dim sPath As String
    sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
    If LCase$(sPath) = "false" Then Exit Sub
     'specify the widths of our fields
     'the number of columns is the number specified in the line below +1
   Dim s(6) As Integer
     'starting at 0 specify the width of each column
    s(0) = 30
    s(1) = 30
    s(2) = 30
    s(3) = 10
    s(4) = 25
    s(5) = 2
    CreateFixedWidthFile sPath, ActiveSheet, s
End Sub