VBA, Automatisation, Boucle

Version imprimable

Bonjour à tous !

Je me suis mis à étudier VBA pour un projet depuis quelques semaines et j'ai créer une macro me permettant de nettoyer mes fichiers des cellules contenant une valeur spécifique.
Cette macro me demande quel dossier traiter et traite un à un chacun des fichiers de ce dossier. A chaque fois que la macro ouvre un fichier, je dois inscrire la valeur à effacer.
J'aimerais effectuer une modification et je n'y arrive pas, je souhaite indiquer la valeur une fois au début du lancement de ma macro et non pas à chaque ouverture de fichier.

Voici l'ensemble de ma macro, cela pourra aussi servir à d'autres qui pourraient en avoir besoin. Merci de votre aide par avance !!

Code:

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
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 <> ""                         ' On effectue la boucle tant qu'il y a un fichier à traiter
  Workbooks.Open Chemin & Fich
  auto_open                                 ' On appel notre macro auto_open
  ActiveWorkbook.Close SaveChanges:=True    ' On ferme le fichier et on sauvegarde les modifications
  Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub
 
Public Sub auto_open()
Dim resultat As String
resultat = InputBox("Valeur contenue dans cellules à nettoyer", "Nettoyage de cellules")
If resultat <> "" Then
    Application.ScreenUpdating = False
    Cells.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=resultat, Replacement:="", LookAt:=xlWhole, MatchCase:=True
    Application.ScreenUpdating = True
    End If
End Sub

02/01/2016, 08h17
Theze

Bonjour,

Dans la sub Auto_Open, tu remplace resultat = InputBox(... par resultat = "ma valeur"

Une solution possible : declarer Resultat en variable globale, demander sa valeur en début de traitement et la passer en paramètre

1) Public Resultat As String

2)

Code:

1
2
3
4
5
'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
   Resultat = InputBox("Valeur contenue dans cellules à nettoyer", "Nettoyage de cellules")

Code:

auto_open Resultat

Code:

1
2
3
4
Public Sub auto_open(txt As String)
Dim Resultat As String
' MsgBox txt - Verif
If txt <> "" Then ...

05/01/2016, 15h00
samy91

Bonjour,

Merci pour vos réponses.
J'ai essayé ta solution theze mais cela ne fonctionne pas.
En ce qui concerne la réponse de sogedic, j'ai peux etre inséré le nouveau code au mauvais endroit (meme si cela m'étonnerait) mais cela ne fonctionne pas non plus.
Sogedic, est-ce possible de m'envoyer mon code modifié afin d'être sure que ce n'est pas moi qui ait fait une erreur au niveau de code?

Je suis donc toujours preneur d'une solution.. ^^

Merci à vous tous !

Bonjour,

J'ai modifié le code mais le résultat sera le même, commence par la sub "SelectionnerRepertoire" :

Code:

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
'routine d'appel depuis le bouton sur feuille
Public Sub SelectionnerRepertoire()
 
    Dim Chemin As String
    Dim Valeur
 
    Chemin = Dossier("C:\") 'adapter le dossier sur lequel on veux ouvrir par défaut
 
    If Chemin = "" Then Exit Sub
 
 
    'demande de confirmation
    If MsgBox("Traiter tous les Fichiers xls du répertoire suivant :" & _
              vbLf & _
              Chemin & _
              vbLf & _
              vbLf & _
              "Veuillez confirmer ?", _
              vbQuestion + vbYesNo, _
              "Traitement des fichiers") = vbYes Then
 
    Valeur = InputBox("Indiquez la valeur des cellules à nettoyer !", "Nettoyage.")
 
    If Valeur = "" Then Exit Sub
 
        'appel la routine de traitement des fichiers
        BoucleDeTraitement Chemin, Valeur
 
        MsgBox "Traitement terminé !", vbInformation
 
    Else
 
       MsgBox "Traitement abandonné !", vbExclamation
 
    End If
 
End Sub
 
Private Sub BoucleDeTraitement(Chemin As String, ValeurCel)
 
    Dim Cls As Workbook
    Dim Fe As Worksheet
    Dim Fich As String
 
    Application.ScreenUpdating = False
 
    'ChDir Chemin
 
    Fich = Dir(Chemin & "*.xls")
 
    'On effectue la boucle tant qu'il y a un fichier à traiter
    Do While Fich <> ""
 
        Set Cls = Workbooks.Open(Chemin & Fich)
 
        For Each Fe In Cls.Worksheets
 
            On Error Resume Next 'si pas de cellules conrrespondantes
            Fe.Cells.SpecialCells(12).SpecialCells(2).Replace ValeurCel, "", 1, , True
            On Error GoTo 0
 
        Next Fe
 
        'On ferme le fichier et on sauvegarde les modifications
        ActiveWorkbook.Close True
 
        Fich = Dir
 
    Loop
 
    Application.ScreenUpdating = True
 
End Sub
 
Function Dossier(Dos As String) As String
 
    With Application.FileDialog(4)
 
        .InitialFileName = Dos
 
        If .Show = -1 Then
 
            Dossier = .SelectedItems(1)
            If Right(Dossier, 1) <> "\" Then Dossier = Dossier & "\"
 
        End If
 
    End With
 
End Function

Code entier

Bonjour

Voici le code en entier

Code:

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
60
61
 
Public Chemin, Fich As String, ReponseMsgBox As Variant
Dim resultat As String
 
'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
    resultat = InputBox("Valeur contenue dans cellules à nettoyer", "Nettoyage de cellules")
    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 <> ""                         ' On effectue la boucle tant qu'il y a un fichier à traiter
  Workbooks.Open Chemin & Fich
  auto_open resultat                                ' On appel notre macro auto_open
  ActiveWorkbook.Close SaveChanges:=True    ' On ferme le fichier et on sauvegarde les modifications
  Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub
 
Public Sub auto_open(resultat As String)
 
If resultat <> "" Then
    Application.ScreenUpdating = False
    On Error Resume Next
    'prévoir le cas ou l'on ne trouve pas
    Cells.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Replace What:=resultat, Replacement:="", LookAt:=xlWhole, MatchCase:=True
    On Error GoTo 0
    Application.ScreenUpdating = True
    End If
End Sub

12/01/2016, 12h58
samy91

Merci Sogedic c'est ce que je cherchais à faire !