XL 2016 Bug macro sur boucle FOR EACH depuis MAJ Office

[samimi94]

Bonjour le forum,

Je sollicite de nouveau votre aide suite à plusieurs recherches infructueuses.

Je rencontre un problème d’exécution d'une macro sous 2016 (pack 365) depuis la mise à jour du pack Office cette semaine.

L’exécution "pas à pas" semble indiquer que le bug se produit sur deux boucles :

 Dim x As Range
    For Each x In Selection
        x = suppAccent(x.Value)
    Next x

et

Set Plage = Intersect(Selection, ActiveSheet.UsedRange)
If Plage Is Nothing Then Exit Sub
For Each Cel In Plage
    Cel = UCase(Cel)
Next Cel

Ce problème a été décelé uniquement sous la version 2016 (365), or sur la version 2016 PC même après MAJ la macro fonctionne correctement.

En espérant que cette erreur peut-être corrigée par une simple modification de code.

Merci à tous pour votre aide.

Samimi94

 

[Dranreb]

Bonjour.
Pour produire un fichier texte à champs de longueurs fixes, je pense que j'utiliserais plutôt des instructions de la forme
Mid$(StrLine, Position, Longueur) = Format(expression, format)
StrLine étant initialisé non à vbNullString mais à String(LongEnreg, " ") ou mieux déclaré As String * LongEnreg

 

[Dranreb]

S'il faut aussi un CrLf à la fin de chaque champ je procèderait peut être autrement:
StrLine = String(LongChamp, " ") suivi de
LSet StrLine = expression ou RSet StrLine = expression

De toute façon il serait bon que les longueurs imposées soient dans un Array.

 

[Staple1600]

Bonsoir le fil, le forum

De toute façon il serait bon que les longueurs imposées soient dans un Array.

Bonsoir Dranreb

C'est le cas non ?

vArry = _
    Array(8, 1, 6, 15, 9, 2, 10, 32, 32, 32, 10, 27, 2, 2, 30, 30, 25, 12, 10, 32, 32, 32, 10, 27, 2, 59)

 

[Dranreb]

Oui, possible, je n'ai regardé la chose qu'en diagonale.

 

[Staple1600]

Re

@Dranreb
Si jamais tu peux (ou veux) jeter un œil en long et en large, n'hésites pas
Je passe volontiers le relais

Voilà où j'en étais resté dans ma dernière livraison

Private Sub CreateFile()
'basé sur:FixedFieldTextFile|McGimpsey|231204
Const DELIMITER As String = ""
Const PAD As String = " "
Dim vArry As Variant, vFormat As Variant, dat_a As Range, nFileNum&, i&, sOut$, sMyString$, fiTXT$, NomFic$
NomFic = InputBox("Saisir le nom du fichier TXT qui sera exporté dans le répertoire courant.", "Export TXT", ActiveSheet.Name)
fiTXT = _
    ThisWorkbook.Path & "\" & NomFic & ".txt"
vArry = _
    Array(8, 1, 6, 15, 9, 2, 10, 32, 32, 32, 10, 27, 2, 2, 30, 30, 25, 12, 10, 32, 32, 32, 10, 27, 2, 59)
vFormat = Array("@", "@", "@", "@", "0000", "00", "00", "@", "@", "@", "@", "@", "@", "00", "@", "@", "@", "@", "@", "@", "@", "@", "@", "@", "@", "@")
nFileNum = FreeFile
Open fiTXT For Output As #nFileNum
For Each dat_a In Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row)
    With dat_a
        For i = 0 To UBound(vArry)
        sMyString = Format(.Offset(0, i).Text, vFormat(i))
        sOut = sOut & DELIMITER & Left(sMyString & String(vArry(i), PAD), vArry(i))
        Next i
    Print #nFileNum, Mid(sOut, Len(DELIMITER) + 1)
    sOut = Empty
    End With
Next dat_a
Close #nFileNum
End Sub

 

[Dranreb]

Comme dit, j'aurais personnellement plus confiance dans des instructions Mid$ (et non la fonction Mid$) que dans une concaténation.
Ça donnerait donc quelque chose comme ça :

Private Sub CreateFile()
'basé sur:FixedFieldTextFile|McGimpsey|231204
Dim NomFic$, FiTxt$, TLgr(), TFmt(), I&, LgrTot&, ZEnreg$, RngColA As Range, Pos&, Lgr&
NomFic = InputBox("Saisir le nom du fichier TXT qui sera exporté dans le répertoire courant.", "Export TXT", ActiveSheet.Name)
FiTxt = ThisWorkbook.Path & "\" & NomFic & ".txt"
TLgr = Array(8, 1, 6, 15, 9, 2, 10, 32, 32, 32, 10, 27, 2, 2, 30, 30, 25, 12, 10, 32, 32, 32, 10, 27, 2, 59)
TFmt = Array("@", "@", "@", "@", "0000", "00", "00", "@", "@", "@", "@", "@", "@", "00", "@", "@", "@", "@", "@", "@", "@", "@", "@", "@", "@", "@")
For I = 0 To UBound(TLgr): LgrTot = LgrTot + TLgr(I): Next I
ZEnreg = String(LgrTot, " ")
Open FiTxt For Output As #1
For Each RngColA In Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row)
   Pos = 1
   For I = 0 To UBound(TLgr)
      Lgr = TLgr(I)
      Mid$(ZEnreg, Pos, Lgr) = Format(RngColA.Offset(0, I).Value, TFmt(I))
      Pos = Pos + Lgr: Next I
    Print #1, ZEnreg: Next RngColA
Close #1
End Sub

À tester.

 

[Staple1600]

Re

@Dranreb
J'ai testé.
Je constate des différences avec mes précédents essais

exemple (1)
T22,35
exemple (2)
VIREMENTNCAI15/03/2018MAGASIN Z

J'attends le retour de samimi94 pour poursuivre plus avant