[XL 2010] VBA : Boucle cassé après 2 fichiers non trouvés

Mikael_D

XLDnaute Nouveau
Bonjour,

Je vous donne mon code afin qu'une bonne ame puise me venir en aide car ma macro s'arrête après qu'il est rencontré un 2eme fichier manquant

Sub Récupération_n°_bordereaux()
Dim repert As String
Dim fich As String
Dim feuil As String
Dim feuil2 As String

Application.DisplayAlerts = False

On Error GoTo err

Sheets("Récap").Select
Range("A2").Select

Do While ActiveCell.Offset.Value <> ""

repert = ActiveCell.Offset(0, 1).Value
fich = ActiveCell.Offset(0, 2).Value
feuil = ActiveCell.Offset(0, 3).Value
feuil2 = ActiveCell.Offset(0, 4).Value
ligne = ActiveCell.Row

ChDir (repert)
Workbooks.Open Filename:= _
(repert & "\" & fich)
Sheets(feuil).Select
ActiveWindow.SmallScroll Down:=-48
numden = Range("B5").Value

Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 5).Value = numden

Windows(fich).Activate
Sheets(feuil2).Select
ActiveWindow.SmallScroll Down:=-48
numden2 = Range("G6").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 6).Value = numden2


Windows(fich).Activate
numden3 = Range("K6").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 7).Value = numden3

Windows(fich).Activate
ActiveWorkbook.Saved = True
ActiveWindow.Close

GoTo Suite


err:

Select Case err.Number
Case 54: Range("F" & ligne).Value = "Fichier introuvable"
Case 76: MsgBox "Chemin incorrect"
Case Else: Range("F" & ligne).Value = "Fichier introuvable"
End Select
GoTo Suite

Suite:
ActiveCell.Offset(1, 0).Select

Loop

Application.DisplayAlerts = True

End Sub


Merci d'avance de votre aide
Mikael
 

vgendron

XLDnaute Barbatruc
Re : [XL 2010] VBA : Boucle cassé après 2 fichiers non trouvés

Hello,

difficile de te répondre sans voir ton fichier avec quelques lignes pour exemple.
je suppose que dedans, tu as des infos contenant des noms de fichier ainsi que le répertoire dans lequel ces fichiers sont censés exister..


sinon
cette ligne me semble bizarre
Do While ActiveCell.Offset.Value <> ""

1) il manque les valeurs pour l'offset: offset(ligne, colonne)

2) juste avant le loop tu fais déjà un activecell.offset(1,0).select..

du coup, j'ai peur que tu ignores une ligne sur deux..
 

camarchepas

XLDnaute Barbatruc
Re : [XL 2010] VBA : Boucle cassé après 2 fichiers non trouvés

Bonjour Vgendron, Mikael ,

Il manque peut être le err.clear pour annuler la premiére erreur ?
 

Mikael_D

XLDnaute Nouveau
Re : [XL 2010] VBA : Boucle cassé après 2 fichiers non trouvés

Ma commende Do While ActiveCell.Offset.Value <> "" me permet de savoir si la cellule est vide
si elle n'est pas vide elle fait la macro sinon rien puis elle descend d'une ligne activecell.offset(1,0).select
 

camarchepas

XLDnaute Barbatruc
Re : [XL 2010] VBA : Boucle cassé après 2 fichiers non trouvés

Re , essaies comme ceci ,

si ça ne va pas , il faudra absoluement un fichier ,

La technique du select c'est pas mal , mais vide compliqué .

Et si les fichiers sont en local , y'a moyen de faire un dir avant de tomber en erreur, si le dir renvois vide alors on passe à la ligne suivante .


Code:
Sub Récupération_n°_bordereaux()
 Dim repert As String
 Dim fich As String
 Dim feuil As String
 Dim feuil2 As String
 Dim ligne As Long
 Dim numden As Long, numden2 As Long, numden3 As Long
Application.DisplayAlerts = False
 

 
Sheets("Récap").Select
 Range("A2").Select
 
Do While ActiveCell.Offset.Value <> ""
 
repert = ActiveCell.Offset(0, 1).Value
 fich = ActiveCell.Offset(0, 2).Value
 feuil = ActiveCell.Offset(0, 3).Value
 feuil2 = ActiveCell.Offset(0, 4).Value
 ligne = ActiveCell.Row
On Error Resume Next

ChDir repert
 Workbooks.Open Filename:= _
 (repert & "\" & fich)
 If err.Number <> 0 Then GoTo Erreur
On Error GoTo 0
 
 Sheets(feuil).Select
 ActiveWindow.SmallScroll Down:=-48
 numden = Range("B5").Value
 
Windows("Récap Montagne.xlsm").Activate
 ActiveCell.Offset(0, 5).Value = numden
 
Windows(fich).Activate
 Sheets(feuil2).Select
 ActiveWindow.SmallScroll Down:=-48
 numden2 = Range("G6").Value
 Windows("Récap Montagne.xlsm").Activate
 ActiveCell.Offset(0, 6).Value = numden2
 

Windows(fich).Activate
 numden3 = Range("K6").Value
 Windows("Récap Montagne.xlsm").Activate
 ActiveCell.Offset(0, 7).Value = numden3
 
Windows(fich).Activate
 ActiveWorkbook.Saved = True
 ActiveWindow.Close
 
GoTo Suite
 

Erreur:
 
Select Case err.Number
 Case 54: Range("F" & ligne) = "Fichier introuvable"
 Case 76: MsgBox "Chemin incorrect"
 Case Else: Range("F" & ligne) = "Fichier introuvable"
 End Select
 err.Clear
 
Suite:
 ActiveCell.Offset(1, 0).Select
 
Loop
 
Application.DisplayAlerts = True
 
End Sub
 

Mikael_D

XLDnaute Nouveau
Re : [XL 2010] VBA : Boucle cassé après 2 fichiers non trouvés

J'aime J'aime J'aime J'aime J'aime

Super programme j'ai juste supprimé la ligne
Dim numden As Long, numden2 As Long, numden3 As Long
qui bloquait

C'est repartiiiiiiiiiiiiiiiiiiiiiii

Merci beaucoup
 

camarchepas

XLDnaute Barbatruc
Re : [XL 2010] VBA : Boucle cassé après 2 fichiers non trouvés

Super donc ,

Comme pas de fichier et pas de donnée , j'ai été au ptit bonheur la chance pour la déclaration .

Mais ces cellules contiennent du texte je pense donc la déclaration serait peut être :

Dim numden As string, numden2 As string, numden3 As string

Bon cela n'est pas obligatoire , mais ça aide bien lorsque l'on sait à quoi s'attendre comme type de valeur dans une variable .

Sur ce Bon Week End et à bientôt .....
 

Discussions similaires


Haut Bas