Discussion :

[ericdev67]

Bonjour,

Je galère :

j'ai mon code qui ouvre tous les classeurs d'un répertoire et va chercher un mot dans les colonnes A:C. : si le mot apparait, il est mis en rouge.

Le but est que si le mot apparait dans ces colonnes, le classeur doit rester ouvert, si le mot n'apparait pas, le classeur doit être fermé. A l'excécution de mon code, VBA ouvre tous les classeurs.

Mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Option Explicit
Option Compare Text
Sub mac()
 
  Dim cellule As Range
  Dim j As Range
  Dim i As Integer
  Dim mot As String
 
  mot = InputBox("VEUILLEZ SAISIR L'ELEMENT A RECHERCHER")
 
  If mot = "" Then Exit Sub
 
  Dim Repertoire As String, Fichier As String
  Dim Wb As Workbook
  Dim Ws As Worksheet
 
  Application.ScreenUpdating = False
 
  'Définit la Première feuille du classeur contenant cette macro
  '(pour recevoir les donnée extraites dans les autres classeurs).
  Set Ws = ThisWorkbook.Worksheets(1)
 
  'Définit le répertoire de recherche
  Repertoire = "C:\essai\eri\"
  'Spécifie la recherche pour le fichiers .xls
  Fichier = Dir(Repertoire & "*.xls")
 
  'Boucle sur les fichiers du répertoire
  Do While Fichier <> ""
    'Vérifie que le nom du classeur est différent du classeur
    'contenant cette macro (dans le cas ou il serait placé dans le même répertoire).
    If ThisWorkbook.Name <> Fichier Then
      'Ouvre chaque classeur
      Set Wb = Workbooks.Open(Repertoire & Fichier)
      For Each cellule In Range("A1:C30000")
        If UCase(cellule.Value) Like "*" & UCase(mot) & "*" Then
 
          'ici on mettra en gras rouge
          cellule.Font.Color = vbRed
          cellule.Font.Bold = True
          Set j = cellule
        End If
      Next
      If j Is Nothing Then
        Wb.Close False
      End If
 
      Application.ScreenUpdating = True
    End If
 
    Fichier = Dir
 
  Loop
 
  Application.ScreenUpdating = True
  MsgBox "Terminé"
 
End Sub

Je ne comprends pas pourquoi, le code ouvre tous les classeurs, même ceux qui ne contiennent pas le mot....

Merci
A+

[Le Pierre]

bonjour

il manque simplement l'initialisation de ta variable de test avant de tester un nouveau fichier.
voici le morceau de code avec l'ajout en gras :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
  'Boucle sur les fichiers du répertoire
  Do While Fichier <> ""
    'Vérifie que le nom du classeur est différent du classeur
    'contenant cette macro (dans le cas ou il serait placé dans le même répertoire).
    If ThisWorkbook.Name <> Fichier Then
        Set j = Nothing
      'Ouvre chaque classeur
      Set Wb = Workbooks.Open(Repertoire & Fichier)

à plus

[ericdev67]

Bonjour Le Pierre,

Pile-poil dans le mille !!!!!!

C'était effectivement cette instruction qui manquait....J'ai passé un certain temps à la mettre à la fin du code, alors qu'il fallait simplement la mettre au début....

Merci

A+ pour de prochaines aventures