Macro qui ignore un On error resume next sur un réseau qui fonctionne en local

Xlcium · 11 Décembre 2012

Bonjour,

Je vous fais part d'une bizarrerie.

En local (sous c:\mes documents) la macro ci dessous s'exécute très bien, elle fait ce qu'on lui demande, en somme elle va lire le contenu d'un dossier et copie le contenu de fichiers excel d'un autre dossier dans un seul fichier excel récap.

Lorsque l'on essaye de faire tourner cette macro sur un réseau, à chaque erreur (à chaque fichier excel non trouvé) la macro bloque à l'entré du If Err.Number = 1004 Then, et ne fait que d'afficher des fenêtres pop up, en lieu et place de noter le nom du fichier incriminé...

Bref, j'ai déjà passé de longues heures sur l'analyse du code, je ne trouve pas...

Pour information, je n'ai fais que de relire ce code, je n'en suis pas l'auteur (qui n'est plus joignable d'ailleurs).

Par avance, merci pour vos retours et analyse sur cette macro.

Cordialement,

Sub traitement()
'

Application.ScreenUpdating = False

'Definition variable
Sheets("Commande").Select
Fict = Range("s5")
Chem = Range("e6")
modele = Range("s7")
Fichier = Chem & "\" & modele
'nom du fichier a créer
FRecapCAP = Range("S9")
Fichier1 = Chem & "\" & FRecapCAP

Sheets("PGF").Select
NbCB = Range("A1")
cpt = 0
Sheets("Anomalies").Select
Range("B3:B1000").ClearContents
Range("B3").Select

'Ouverture fichier modele et creation 1 fichiers de recup

'ChDir Chem
Workbooks.Open Filename:=Fichier
Sheets(1).Copy
ActiveSheet.Unprotect
Range("A12500").ClearContents
ActiveWorkbook.SaveAs Filename:=Fichier1
Range("a8").Select
Windows(modele).Activate
ActiveWorkbook.Close

'Boucle : ouvre chaque fichiers de la liste sur onglet pgf
'recupere les données collées sur les 3 fichiers crées

Windows(FRecapCAP).Activate
Range("A7").Select

Windows(Fict).Activate
Sheets("PGF").Select
Range("B1").Select
cpt = 0

While cpt < NbCB
cpt = cpt + 1
Windows(Fict).Activate
Sheets("PGF").Select
ActiveCell.Offset(1, 0).Range("A1").Select
NumCB = ActiveCell
FNumCB = Chem & "\" & "CB" & NumCB
FNumCB1 = "CB" & NumCB & ".xls"

On Error Resume Next
Workbooks.Open Filename:=FNumCB

'si un num de cb n'est pas trouvé son numero est reporté sur l'onglet anomalies
If Err.Number = 1004 Then
Sheets("Anomalies").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = FNumCB

Else
Sheets(1).Select
Range("A13:T57").Copy
Windows(FRecapCAP).Activate
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Windows(FNumCB1).Activate

ActiveWorkbook.Close
End If

Wend
'Stop
'mise en forme des bases
Windows(FRecapCAP).Activate
Cells.Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Selection.FormatConditions.Delete
Rows("13:13").Select
Selection.Copy
Rows("10:20000").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.Sort Key1:=Range("D7"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Rows("10:30000").Select
Selection.Sort Key1:=Range("d10"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'Stop
'Création des fichiers spécifiques

'message de fin
Windows(Fict).Activate
Sheets("Commande").Select
MsgBox ("Fin du traitement un fichier par type d'ecriture a été generé 1 fichier !, La base est ouverte !")

End Sub

youky(BJ) · 11 Décembre 2012

Re : Macro qui ignore un On error resume next sur un réseau qui fonctionne en local

Bonjour,
Non testé
Peut être une solution si N° est différent de 1004
Si erreur alors on efface l'erreur avant de continuer avec la boucle Wend7

'si un num de cb n'est pas trouvé son numero est reporté sur l'onglet anomalies
'If Err.Number = 1004 Then
' Sheets("Anomalies").Select
If Err>0 Then
Err.Clear
Sheets("Anomalies").Select

Bruno

Robert · 11 Décembre 2012

Re : Macro qui ignore un On error resume next sur un réseau qui fonctionne en local

Bonsoir le fil, bonsoir le forum,

Je plussoie Bruno... Peut-être aussi rajouter l'annulation de la gestion des erreurs :

Code:

End If
On Error GoTo 0
Wend

Xlcium · 12 Décembre 2012

Re : Macro qui ignore un On error resume next sur un réseau qui fonctionne en local

Bonjour,

J'ai essayé l'une puis l'autre des solutions, la combinaison des deux...rien n'y fait, j'ai toujours le message ci dessous lorsque la macro entre dans la boucle.
C'est un message par fichier non trouvé...

J'ai regardé les propriétés du dossier d'écriture de la macro, les accès sont OK.

Merci d'avance pour vos autres pistes...

youky(BJ) · 12 Décembre 2012

Re : Macro qui ignore un On error resume next sur un réseau qui fonctionne en local

Cela ne ressemble pas à une erreur mais à un avertissement!
Donc peut être neutraliser les messages par:

Application.DisplayAlerts = False
Workbooks.Open Filename:=FNumCB
Application.DisplayAlerts = True

Bruno

Xlcium · 13 Décembre 2012

Re : Macro qui ignore un On error resume next sur un réseau qui fonctionne en local

Merci Bruno alias youky !

Alors maintenant le truc c'est que la macro ne fait que de rester dans la boucle du IF, en gros elle ignore la présence de fichiers excel dans le répertoire de lecture...si quelqu'un peut essayer de me dire d'où ça peut venir...

Merci beaucoup !

While cpt < NbCB
cpt = cpt + 1
Windows(Fict).Activate
Sheets("PGF").Select
ActiveCell.Offset(1, 0).Range("A1").Select
NumCB = ActiveCell
FNumCB = Chem & "\" & "CB" & NumCB
FNumCB1 = "CB" & NumCB & ".xls"

On Error Resume Next
Application.DisplayAlerts = False
Workbooks.Open Filename:=FNumCB
Application.DisplayAlerts = True

'si un num de cb n'est pas trouvé son numero est reporté sur l'onglet anomalies
If Err.Number <> 0 Then

Sheets("Anomalies").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell = FNumCB

Else
Sheets(1).Select
Range("A13:T57").Copy
Windows(FRecapCAP).Activate
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Windows(FNumCB1).Activate

ActiveWorkbook.Close
End If

Wend

youky(BJ) · 13 Décembre 2012

Re : Macro qui ignore un On error resume next sur un réseau qui fonctionne en local

Oui car tu n'as pas mis le Err.Clear pour effacer l'erreur.(je l'ai mis dans cette macro)
Petit ttruc supplémentaire le On Errorresume next n'a pas besoin d'être dans une boucle et répété

Donc on le place en 1er et on le supprime dans la boucle
ce qui donne:

Code:

            On Error Resume Next
While cpt < NbCB
            cpt = cpt + 1
            Windows(Fict).Activate
            Sheets("PGF").Select
            ActiveCell.Offset(1, 0).Range("A1").Select
            NumCB = ActiveCell
            FNumCB = Chem & "\" & "CB" & NumCB
            FNumCB1 = "CB" & NumCB & ".xls"

            Application.DisplayAlerts = False                       
            Workbooks.Open Filename:=FNumCB                         
            Application.DisplayAlerts = True


    'si un num de cb n'est pas trouvé son numero est reporté sur l'onglet anomalies
            If Err.Number <> 0 Then
             Err.Clear
            Sheets("Anomalies").Select
            ActiveCell.Offset(1, 0).Range("A1").Select
            ActiveCell = FNumCB

            Else
                Sheets(1).Select
                Range("A13:T57").Copy
                Windows(FRecapCAP).Activate
                Selection.End(xlDown).Select
                ActiveCell.Offset(1, 0).Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
                Application.CutCopyMode = False
                Windows(FNumCB1).Activate

                ActiveWorkbook.Close
            End If

        Wend

Bruno

Macro qui ignore un On error resume next sur un réseau qui fonctionne en local

Xlcium

XLDnaute Nouveau

youky(BJ)

XLDnaute Barbatruc

Robert

XLDnaute Barbatruc

Xlcium

XLDnaute Nouveau

Pièces jointes

youky(BJ)

XLDnaute Barbatruc

Xlcium

XLDnaute Nouveau

youky(BJ)

XLDnaute Barbatruc

Discussions similaires