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

Xlcium

XLDnaute Nouveau
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("A12:p500").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)

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

XLDnaute Barbatruc
Repose en paix
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

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

Pièces jointes

  • Copie erreur.jpg
    Copie erreur.jpg
    13.4 KB · Affichages: 45

youky(BJ)

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

XLDnaute Nouveau
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)

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

Discussions similaires

Statistiques des forums

Discussions
312 345
Messages
2 087 487
Membres
103 558
dernier inscrit
Lamine ABIDI