XL 2016 Bug macro sur boucle FOR EACH depuis MAJ Office

samimi94 · 17 Mars 2018

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 :

Code:

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

et

Code:

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 · 19 Mars 2018

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 · 19 Mars 2018

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 · 19 Mars 2018

Bonsoir le fil, le forum

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

Bonsoir Dranreb

C'est le cas non ?

VB:

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 · 19 Mars 2018

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

Staple1600 · 19 Mars 2018

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

VB:

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 · 19 Mars 2018

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 :

VB:

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 · 19 Mars 2018

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

XL 2016 Bug macro sur boucle FOR EACH depuis MAJ Office

samimi94

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires