IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Script bloquant le lancement d'une macro si.. [XL-2003]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre du Club
    Homme Profil pro
    Gestionaire
    Inscrit en
    Juillet 2012
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Gestionaire
    Secteur : Service public

    Informations forums :
    Inscription : Juillet 2012
    Messages : 6
    Par défaut 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 ), 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.

  2. #2
    Membre Expert
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 817
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 817
    Billets dans le blog
    10
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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.

  3. #3
    Membre du Club
    Homme Profil pro
    Gestionaire
    Inscrit en
    Juillet 2012
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Gestionaire
    Secteur : Service public

    Informations forums :
    Inscription : Juillet 2012
    Messages : 6
    Par défaut
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  4. #4
    Membre du Club
    Homme Profil pro
    Gestionaire
    Inscrit en
    Juillet 2012
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Gestionaire
    Secteur : Service public

    Informations forums :
    Inscription : Juillet 2012
    Messages : 6
    Par défaut
    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 : 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
     
        '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

  5. #5
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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 : 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
    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 : 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
    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.

  6. #6
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 173
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 173
    Billets dans le blog
    53
    Par défaut
    Bonsoir,
    Je voulais dire bravo à Mercatog pour ce beau code bien propre.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Lancement d'une macro d'un autre classeur
    Par marsupilami34 dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 19/06/2007, 10h31
  2. [VBA-E] Lancement d'une macro en fonction du contenu d'une cellule
    Par Zak Blayde dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 30/01/2007, 15h13
  3. [VBA-E]Probleme de lancement d'une macro non souhaité
    Par Mut dans le forum Macros et VBA Excel
    Réponses: 19
    Dernier message: 06/12/2006, 12h50
  4. [VBA-E] Lancement d'une macro située dans un autre fichier
    Par sat478 dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 07/09/2006, 16h48
  5. Réponses: 2
    Dernier message: 22/07/2002, 12h13

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo