XL 2016 Bug macro sur boucle FOR EACH depuis MAJ Office

samimi94

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
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.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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.
 

Discussions similaires

Réponses
2
Affichages
129

Statistiques des forums

Discussions
311 720
Messages
2 081 899
Membres
101 834
dernier inscrit
Jeremy06510