Correction macro

bonjour les amis j'aurais besoin d'un peut d'aide svp ,

voilà depuis ce matin je cherche à appliquer une macro à un dossier de fichier excel ( macro de controle)

j'ai fait ça mais ça ne marche pas

Public Chemin, Fich As String, ReponseMsgBox As Variant

'                                           .
'routine d'appel depuis le bouton sur feuille
'                                           .
Public Sub SelectionnerRepertoire()
Chemin = FLoadNomDuREP: Chemin = Trim(Chemin): If Chemin = "" Then Exit Sub
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
DoEvents
'demande de confirmation
M$ = "Traiter tous les Fichiers xls du répertoire suivant :" & vbLf & Chemin & vbLf & vbLf & "Veuillez confirmer ?"
ReponseMsgBox = MsgBox(M$, vbQuestion + vbYesNo, "Traitement des fichiers")
If ReponseMsgBox = vbYes Then
   BoucleDeTraitement ' appel la routine de traitement des fichiers
   MsgBox "Traitement terminé !", vbInformation
Else
   MsgBox "Traitement abandonné !", vbExclamation
End If
End Sub

' , &H1&)=avec bouton "créer un nouveau dossier" ... , $H201&)=sans le bouton
'objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&, RepDefaut)
Private Function FLoadNomDuREP() As String
Dim objShell As Object, objFolder As Object, REP As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
If Not objFolder Is Nothing Then
   REP = objFolder.Items.Item.Path
   If Right(REP, 1) <> "\" Then REP = REP & "\"
End If
FLoadNomDuREP = REP
Set objShell = Nothing: Set objFolder = Nothing
End Function

'                                                                               .
'                                                                               .

Private Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
Application.ScreenUpdating = False
ChDir Chemin
Fich = Dir(Chemin & "*.xls")
Do While Fich <> ""
  Workbooks.Open Chemin & Fich
  controle
  ActiveWorkbook.Close True
  Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub

Private Sub controle()

With Worksheets("AR-Synthèse")

derlig = .Range("a" & Rows.Count).End(xlUp).Row

For i = 10 To derlig

' test Positionnement du segment dans une case noire de la matrice (ELS ou PEL)
If .Range("CI" & i) = "Noir" Or .Range("CO" & i) = "Noir" Then
 res = "O"

' test Positionnement du segment dans une case grise ou noire de la matrice (ELS ou PEL) et écart à l'article 14 ou 8
ElseIf (.Range("CI" & i) = "Noire" Or .Range("CO" & i) = "Noire" Or .Range("CI" & i) = "Grise" Or .Range("CO" & i) = "Grise") And (.Range("DQ" & i) = "O" Or .Range("DR" & i) = "O") Then
 res = "O"

' test  Positionnement du segment dans une case grise de la matrice (ELS ou PEL) et année de pose >=2006
ElseIf (.Range("CI" & i) = "Gris" Or .Range("CO" & i) = "Gris") And .Range("P" & i) >= 2006 Then
 res = "O"
Else
 res = "N"
End If
'mettre résultat en colonne DS
.Range("DS" & i) = .Range("F" & i) & " devrait être " & res
Next i
End With

End Sub

si vous pouviez m'aider merci

Bonjour

ltawolf16 a écrit :

ça ne marche pas

Cela ne veut pas dire grand-chose

Détailles "ça ne marche pas"

Les fichiers s'ouvrent

• -> Oui --> alors voir les tests
• -> Non --> répertoire vide ?, ou extension des fichiers ou .....

Places des MsgBox dans tes macros pour vérifier si le déroulement est normal

Si tu ne trouves pas de solution il faudra ton fichier principal et au moins un fichier à contrôler

A moins que quelqu'un a "the solution"