Script bloquant le lancement d'une macro si..

Version imprimable

25/07/2012, 22h25
Eric202

Script bloquant le lancement d'une macro si..

Bonsoir à tous, ;)

J’extrais le contenu de 2 fichiers (Classeur1 et Classeur2) vers un seul (Classeur3), et j’aimerais créer un script qui va vérifier le nombre de ligne des 2 fichiers « sources »(Classeur 1 et Classeur 2), puis qu’il refuse de lancer le script d’extraction des données si le nombre de lignes des 2 fichiers « sources » (Classeur 1 et Classeur 2) n’est pas le même. Il en informerais l'utilisateur via une Msgbox.

Et donc à l’inverse, le script devrait procéder au lancement de ma macro si et seulement si le nombre de lignes des 2 fichiers sources correspond.

A noter que mes 2 classeurs sources contiennent tout 2 une entête de titre de colonne allant de Range(Cells(1,1),Cells(1,156)).

Voilà l’architecture de mon programme :

Sub macro_principale ()
…
Ouverture des fichiers 1 et 2
Copie vers classeur3
Manipulation de données
Enregistrer sous
Fermeture des fichiers
End sub

A la suite de quoi j’ai codé les instructions de chaque sous procédures appelées par ma macro principale.

Donc, j’imagine que le script de validité (num ligne Classeur 1 = num ligne Classeur 2 = True … donc je lance la macro) devrait donner lieu à la création d’un nouvelle sous procédure que je glisserais dans mon code de ma macro principale après l’ouverture des fichiers, mais avant la procédure de copie ?

Voilà, ça n’a pas l’air bien compliqué (pour certains du moins :oops:), mais j’ai voulu détailler le plus possible pour faciliter la résolution.

J’espère ne pas trop vous en demander, et je serai très reconnaissant si quelqu'un pouvez me filer un coup de main sur ce casse tête.

Eric.

Bonjour Eric,

Effectivement ce n'est pas très compliqué. Il te faut juste connaître le code VBA qui te donne le numéro de la dernière ligne saisie.
Quelques exemples ici.
Je te recommande celui-ci car tu viens juste d'ouvrir les deux fichiers concernés :
Renvoie la dernière ligne absolue non vide dans la feuille.
Attention: Si des lignes sont supprimées dans la plage, enregistrez préalablement le fichier pour que la procédure renvoie la réelle dernière ligne
Code:

1 2 Dim DerniereLigne As Long DerniereLigne = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Bon, il te faut ça pour tes deux fichiers.
Dans l'exemple, je choisis d'utiliser la feuille "Feuil3" des fichiers Classeur1.xls et Classeur2.xls :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Dim DerniereLigneFic1 As Long, DerniereLigneFic2 As Long With WorkBooks("Classeur1.xls").Sheets("Feuil3") DerniereLigneFic1 = .Range("A1").SpecialCells(xlCellTypeLastCell).Row End With With WorkBooks("Classeur2.xls").Sheets("Feuil3") DerniereLigneFic2 = .Range("A1").SpecialCells(xlCellTypeLastCell).Row End With If DerniereLigneFic1 <> DerniereLigneFic2 Then MsgBox "Nombre de lignes différents! Classeur1 : " & DerniereLigneFic1 & " lignes, Classeur2 : " & DerniereLigneFic2 & " lignes." Exit Sub End If
Code non testé, il peux y avoir une ou deux petites boulettes...
Par contre, il ne faut pas placer ce code dans une sous-procédure appelée par la procédure principale. En effet, si tu fais cela, le "Exit Sub" ne fera que quitter la sous-procédure et ta procédure principale s'exécutera. Tu places donc ces quelques lignes, dans ta procédure principale, après l'ouverture des deux fichiers.

26/07/2012, 18h48
Eric202

Hello Franck,

Le code fonctionne remarquablement bien et je t'en remercie très sincèrement.

Le hic très léger, c'est que l'ouverture de mes classeurs est également une sous procédure appelée par ma macro principale (comme les opérations de traitement et de sauvegarde).
Du coup j'ai malgré tout l’avertissement de divergences du nombre de ligne, mais la macro principale continu d'appeller les autres sous procédures.

J'ai bien testé un :

Code:

Exit Sub macro_principale

dans le code que tu m'a donné, mais ça ne donne rien.

Ou alors je rajoute dans la message box que les résultats de l'extraction des données ne sera pas fiable.

En tout cas, je te suis très reconnaissant, merci ;)

Coucou à tous,

Je relance le post pour te remercier une nouvelle fois Franck, et dire que j’ai solutionné mes difficultés perso de cette façon :

- J’ai intégrer le script dans la sous procédure qui est appelée par ma macro principale
- -Remplacé l’instruction Exit Sub X par l’instruction End (qui met fin à tout, merci touche F1)
- Remplacé la référence Range : « SpecialCells(xlCellTypeLastCell).Row » par « CurrentRegion.Rows.Count ». En faisant des tests de modification volontaire du nombre de lignes, puis retour au même nombre, le script continuer de prétendre que le nombre de ligne était différent (et assez bizarrement le changement opéré à réglé ce problème).
- J’ai ajouté la fermeture des classeurs sources pour faire plus propre.

Ca n’était pas d’une grande difficulté et c’est Franck qui a fait l’essentiel du boulot, mais j’avoue être satisfait.

Je passe le post en résolu,
Merci encore,
Eric.
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 'procédure d'ouverture des fichiers + Script de sécurité vérification de cohérence données sources Private Sub ouvrir_fichiers() 'attention classeurs source+masque dans le même dossier (concat. Path classeur actif avec fichier à ouvrir) Set CLASSEUR1 = Workbooks.Open(ThisWorkbook.Path & "\CLASSEUR1.xls") 'ouverture des 2 classeurs sources Set CLASSEUR2 = Workbooks.Open(ThisWorkbook.Path & "\CLASSEUR2.xls") 'script de vérification de la cohérence des données Dim DerniereLigneClasseur1 As Long, DerniereLigneClasseur2 As Long With Workbooks("CLASSEUR1.xls").Sheets("Feuil3") DerniereLigneClasseur1 = .Range("A1").CurrentRegion.Rows.Count End With With Workbooks("CLASSEUR2. xls ").Sheets("Feuil3") DerniereLigneClasseur2 = .Range("A1").CurrentRegion.Rows.Count End With If DerniereLigneClasseur1 <> DerniereLigneClasseur2 Then msgbox "EXTRACTION FAUSSEE ! CLASSEUR1: " & DerniereLigneClasseur1 & " lignes, CLASSEUR2: " & DerniereLigneClasseur2 & " lignes." FermerClasseur ("CLASSEUR1.xls") 'si condition vérifiée ferme les classeurs sources FermerClasseur ("CLASSEUR2.xls") End 'coupe le processus d'intégration global si condition validée End If End Sub

Le End est un cataclysme pour le code.

Sinon, je ferai comme ceci:

1. Fonction qui retourne une situation données (Ouverture des 2 fichiers et comparaison du nombre de lignes.

Si c'est ok, elle retourne le tableau {VRAI, CLASS1, CLASS2} où CLASSi est une variable objet comportant le classeur ouvert Classeuri

Si ce n'est pas ok, elle retourne le tableau {FAUX} dans le cas où l'un des classeur est inexistant ou le nombre de lignes est différent.

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
Private Function Valid(ByVal Classeur1 As String, ByVal Classeur2 As String) As Variant
Dim LastLig1 As Long, LastLig2 As Long
Dim Wbk1 As Workbook, Wbk2 As Workbook
Dim Fichier1 As String, Fichier2 As String
Dim S, So
 
So = Array(False)
 
Fichier1 = ThisWorkbook.Path & "\" & Classeur1
If Dir(Fichier1) <> "" Then                        'Afin de vérifier l'existence du Classeur1
 
    Set Wbk1 = Workbooks.Open(Fichier1)
    LastLig1 = Wbk1.Worksheets(1).Range("A1").CurrentRegion.Rows.Count
 
    Fichier2 = ThisWorkbook.Path & "\" & Classeur2
    If Dir(Fichier2) <> "" Then                    'Afin de vérifier l'existence du Classeur2
 
        Set Wbk2 = Workbooks.Open(Fichier2)
        LastLig2 = Wbk2.Worksheets(1).Range("A1").CurrentRegion.Rows.Count
 
        If LastLig1 <> LastLig2 Then
            MsgBox "EXTRACTION FAUSSEE!" & vbCrLf & " - Classeur " & Classeur1 & _
                   ": " & LastLig1 & " lignes" & vbCrLf & " - Classeur " & Classeur2 & ": " _
                   & LastLig2 & " lignes."
 
            Wbk1.Close False
            Set Wbk1 = Nothing
            Wbk2.Close False
            Set Wbk2 = Nothing
            S = So
        Else
            S = Array(True, Wbk1, Wbk2)
        End If
    Else
        S = So
        Wbk1.Close False
        Set Wbk1 = Nothing
    End If
Else
    S = So
End If
Valid = S
End Function

2. Ensuite dans ma procédure principale, il suffit de vérifier Valid(0) si c'est Vrai ou Faux

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub ProcedurePrincipale()
Dim WbA As Workbook, WbB As Workbook
Dim Res
 
Application.ScreenUpdating = False
Res = Valid("Liste stagiaires 2011-2012.xls", "Réponse DS_v2.xls")
If Res(0) Then
    'Code si l'extraction est bonne, les 2 fichiers sont ouverts et sont contenus dans les variables WbA et WbB
    Set WbA = Res(1)
    Set WbB = Res(2)
 
    'Copie vers classeur3
    'Manipulation de données
    'Enregistrer sous
 
    WbA.Close False
    Set WbA = Nothing
    WbB.Close False
    Set WbB = Nothing
    MsgBox "Traitement terminé avec succès!"
End If
End Sub

Enfin, c'est juste une proposition organisée, certes avec plus de lignes de code.

27/07/2012, 23h10
Philippe Tulliez

Bonsoir,
Je voulais dire bravo à Mercatog pour ce beau code bien propre.