Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel ben poukoi "la boucle"

ben poukoi "la boucle"

16 réponses
Avatar
tip.tiptop
Bonsoir tout le monde,
j'utilise dans mon code une boucle qui me permet d'ouvrir tous les fichiers
de type *.xls d'un répertoire.
Cette boucle fonctionne parfaitement tant que mon code sort de la boucle
sans modifier les fichiers aouverts.
Sortie de la boucle par la commande: Windows(f).Close


Mais voila le hic, lorsque j'utilise la même boucle pour ouvrir tous les
fichiers de type *.xls d'un répertoire et souhaite enregistrer le fichier
ouvert la boucle boucle indéfinement.

il semble que le fichier ouvert et refermé soient différent malgré qu'ils
portent le même nom.

D'ou la boucle infini.

Comment résoudre ce problème????



ci dessous les lignes de codes qui fonctionnent



par avnace merci.



Sub Macro3()

'

'***************************************************************************

'Ouvrir tous les fichiers de type .xls d'un répertoire donnée

'***************************************************************************

Application.GetOpenFilename

f = Dir("*.xls")

Do While Len(f) > 0

Workbooks.Open f, UpdateLinks:=0

Windows(f).Activate



MON CODE

MON CODE



Application.DisplayAlerts = False

Windows(f).Close

Application.DisplayAlerts = True

'***************************************************************************

'Ouvrir classeur suivant

'***************************************************************************

f = Dir

'***************************************************************************

'Fin de boucle ouverture classeurs

'***************************************************************************

Loop

End Sub



Mainteant celles qui ne fonctionnent pas
Sub Macro3()

'

'***************************************************************************

'Ouvrir tous les fichiers de type .xls d'un répertoire donnée

'***************************************************************************

Application.GetOpenFilename

f = Dir("*.xls")

Do While Len(f) > 0

Workbooks.Open f, UpdateLinks:=0

Windows(f).Activate



MON CODE

MON CODE



Application.DisplayAlerts = False

ActiveWorkbook.Save

Windows(f).Close

Application.DisplayAlerts = True

'***************************************************************************

'Ouvrir classeur suivant

'***************************************************************************

f = Dir

'***************************************************************************

'Fin de boucle ouverture classeurs

'***************************************************************************

Loop

End Sub
Signaler un problème avec ce contenu

6 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
tip.tiptop
Désolé mais je trouve pas poukoi.

peux-tu faire un dernier essai avec les quelques lignes suivantes?
Sur mon PC perso et celui du boulot,je rebouche indéfiniment

Sub Macro4()

Application.GetOpenFilename
f = Dir("*.xls")

Do While Len(f) > 0
Workbooks.Open f, UpdateLinks:=0
ActiveWorkbook.Close True
f = Dir
Loop

End Sub

par avance merci pour ton aide
Avatar
tip.tiptop
Désolé mais je trouve pas poukoi.

peux-tu faire un dernier essai avec les quelques lignes suivantes?
Sur mon PC perso et celui du boulot,je rebouche indéfiniment

Sub Macro4()

Application.GetOpenFilename
f = Dir("*.xls")

Do While Len(f) > 0
Workbooks.Open f, UpdateLinks:=0
ActiveWorkbook.Close True
f = Dir
Loop

End Sub

par avance merci pour ton aide




Avatar
lSteph
Bonsoir,

Chez moi aussi ça part en vrille aussi ton truc, alors que j'ai des
macros analogues
qui ne font pas cela du tout,à croire qu'une instruction de la macro
qui met les formats
ou autre que je n'ai pas analysé entraine un décalage récursif de Dir
qui se met à repasser au premier à la fin
Voici qui devrait bloquer ce phénomène:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''
Public myPath
Public Sub Choixrep()
Dim objShell As Object, objFolder As Object, message As String
message = "Vous pouvez choisir un répertoire ou même en créer un" _
& vbCrLf & "il sera choisi pour l'execution de la macro"

On Error Resume Next
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, message, 0, "c:")
myPath = objFolder.parentfolder.ParseName(objFolder.Title).Path
If Len(myPath) = 0 Then
MsgBox "Opération de choix abandonnée": End
Else
MsgBox myPath
End If
End Sub

Sub Mamacro()
Dim f As String, myfs As New Collection
Call Choixrep

ChDir myPath
f = Dir("*.xls")
Application.ScreenUpdating = False
Do While Len(f) > 0
On Error GoTo fin
myfs.Add f, f
On Error GoTo 0
Workbooks.Open f
Call moncode
f = Dir
ActiveWorkbook.Close True
Loop
fin:
Do While myfs.Count > 0
myfs.Remove 1
Loop
End Sub
Sub moncode()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
With sh
If .Name <> " Effectifs" And .Name <> " Répertoire" Then
.Unprotect
.[O7:O16].NumberFormat = "General"
.[P7:P16].NumberFormat = "m/d/yyyy"
Application.CutCopyMode = False
.[O6:P16].Copy
.Range("O17, O28, O39, O50, O61").PasteSpecial _
Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
.Protect 'peut-être

End If
End With
Next sh

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''
'lSteph

On 10 juil, 17:28, "tip.tiptop" wrote:
Désolé mais je trouve pas poukoi.

peux-tu faire un dernier essai avec les quelques lignes suivantes?
Sur mon PC perso et celui du boulot,je rebouche indéfiniment

Sub Macro4()

Application.GetOpenFilename
f = Dir("*.xls")

Do While Len(f) > 0
Workbooks.Open f, UpdateLinks:=0
ActiveWorkbook.Close True
f = Dir
Loop

End Sub

par avance merci pour ton aide


Avatar
Daniel
Ca fonctionne correctement. Qu'est-ce qu'il a d'anormal, mon Excel ?
Daniel
"tip.tiptop" a écrit dans le message de news:
f708l5$eel$
Désolé mais je trouve pas poukoi.

peux-tu faire un dernier essai avec les quelques lignes suivantes?
Sur mon PC perso et celui du boulot,je rebouche indéfiniment

Sub Macro4()

Application.GetOpenFilename
f = Dir("*.xls")

Do While Len(f) > 0
Workbooks.Open f, UpdateLinks:=0
ActiveWorkbook.Close True
f = Dir
Loop

End Sub

par avance merci pour ton aide





Avatar
lSteph
ce petit bout de code lui ne part pas en boucle!



On 10 juil, 17:28, "tip.tiptop" wrote:
Désolé mais je trouve pas poukoi.

peux-tu faire un dernier essai avec les quelques lignes suivantes?
Sur mon PC perso et celui du boulot,je rebouche indéfiniment

Sub Macro4()

Application.GetOpenFilename
f = Dir("*.xls")

Do While Len(f) > 0
Workbooks.Open f, UpdateLinks:=0
ActiveWorkbook.Close True
f = Dir
Loop

End Sub

par avance merci pour ton aide


Avatar
tip.tiptop
Bonsoir,
Un grand merci à Isteph et Daniel pour leur aide.
Mon code bien que beaucoup moins optimisé fonctionne tout aussi bien que vos
solutions.
La seule explication que j'ai c'est que le plantage "la boucle" à l'infini
se produit lorsque le path du répertoire ou le dir est effectué comporte une
grande aboresnce.!!!!!

Encore mille merci.

Un positionnant le repertoire à la racine de mon disque toutes les solutions
fonctionnent
"Daniel" a écrit dans le message de news:

Ca fonctionne correctement. Qu'est-ce qu'il a d'anormal, mon Excel ?
Daniel
"tip.tiptop" a écrit dans le message de news:
f708l5$eel$
Désolé mais je trouve pas poukoi.

peux-tu faire un dernier essai avec les quelques lignes suivantes?
Sur mon PC perso et celui du boulot,je rebouche indéfiniment

Sub Macro4()

Application.GetOpenFilename
f = Dir("*.xls")

Do While Len(f) > 0
Workbooks.Open f, UpdateLinks:=0
ActiveWorkbook.Close True
f = Dir
Loop

End Sub

par avance merci pour ton aide








1 2