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 :

ma macro s'interrompt sans raison [XL-MAC 2011]


Sujet :

Macros et VBA Excel

  1. #1
    Membre éclairé Avatar de Giantrick
    Profil pro
    Inscrit en
    Janvier 2007
    Messages
    300
    Détails du profil
    Informations personnelles :
    Âge : 52
    Localisation : France

    Informations forums :
    Inscription : Janvier 2007
    Messages : 300
    Par défaut ma macro s'interrompt sans raison
    Bonjour à tous,

    Je travaille sur une version excel 2011 avec macro et je fais en sorte qu'elle tourne sur la version 2010 PC. ce qui est le cas pour le moment.

    Mais voilà, j'ai commencé à travaillé sur mes macros comme en programmation objet en appelant mes fonctions avec des "call" et peut être que c'est le problème.

    Avant de vous montrer le code, je tiens à dire que j'ai testé chaque code indépendamment et que tout fonctionne.

    De plus, il suffit que je les appelle dans un ordre différent et le code s'arrête toujours au même endroit dans la macro principale. Même si j'inverse deux sous-programmes.

    Exemple (partiel de la macro):
    La macro s'arrête à la ligne 16 :
    Call SAVE_JOINTURE("SAISIE_ENTITE")
    mais si je l'inverse (la ligne 14 et 16) avec celle du dessus
    Call SAVE_ENTITE("SAISIE_ENTITE")
    le sous-programme (SAVE_JOINTURE) va s'exécuter et SAVE_ENTITE se bloquera toujours après avoir exécuter le premier sous-programme.

    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
     Définition des variables
    Dim CellControljointure As Range, CellVerifSaisie As Range, CellVerifSaisieEntite As Range, _
    CellVerifSaisieContact As Range
    Windows("Module_contact.xlsm").Activate
        Set CellVerifSaisieContact = Sheets("SAISIE_ENTITE").Range("$AA$15")
        Set CellVerifSaisieEntite = Sheets("SAISIE_ENTITE").Range("$AA$16")
        Set CellVerifSaisie = Sheets("SAISIE_ENTITE").Range("$AA$18")
        Set CellControljointure = Sheets("SAISIE_ENTITE").Range("$CD$2")
     
    ' Gestion des conditions
     If CellVerifSaisie.Value = 35 Then
          Call UNPROTECTION_ONGLET("bdd_contact.xlsx", "bdd_entite")
          Call UNPROTECTION_ONGLET("bdd_contact.xlsx", "jointure_entite_contact")
          Call SAVE_ENTITE("SAISIE_ENTITE")
                If CellControljointure = 1 Then
                  Call SAVE_JOINTURE("SAISIE_ENTITE")
                End If
          Call PROTECTION_ONGLET("bdd_contact.xlsx", "bdd_entite")
          Call PROTECTION_ONGLET("bdd_contact.xlsx", "jointure_entite_contact")
    End If
    Je pense que c'est un problème lié au volume des données qui sont copié car dans chaque sous programme je fais beaucoup de copie de données d'un fichier à un autre, avec des tries.

    Merci de votre retour et idées sur le sujet.

    Bien à vous

  2. #2
    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
    Tu travailles avec plusieurs classeurs, il serait utile d'éliminer les Activate et de travailler avec des variables objets Workbook. Aussi, il est demandé de préfixer les Sheets au classeur auquel elles appartiennent.

    Mets ton code en entier et aussi celui des sous procédures appelées.


    PS. Pour le titre, il y a toujours une (des) raison(s) qui engendre(nt) le problème rencontré.

  3. #3
    Membre éclairé Avatar de Giantrick
    Profil pro
    Inscrit en
    Janvier 2007
    Messages
    300
    Détails du profil
    Informations personnelles :
    Âge : 52
    Localisation : France

    Informations forums :
    Inscription : Janvier 2007
    Messages : 300
    Par défaut
    Citation Envoyé par mercatog Voir le message
    Tu travailles avec plusieurs classeurs, il serait utile d'éliminer les Activate et de travailler avec des variables objets Workbook. Aussi, il est demandé de préfixer les Sheets au classeur auquel elles appartiennent.
    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
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    Sub SAISIE_ENTITE()
    '
    '
     
    ' Définition des variables
    Dim CellControljointure As Range, CellVerifSaisie As Range, CellVerifSaisieEntite As Range, _
    CellVerifSaisieContact As Range
    Windows("Module_contact.xlsm").Activate
        Set CellVerifSaisieContact = Sheets("SAISIE_ENTITE").Range("$AA$15")
        Set CellVerifSaisieEntite = Sheets("SAISIE_ENTITE").Range("$AA$16")
        Set CellVerifSaisie = Sheets("SAISIE_ENTITE").Range("$AA$18")
        Set CellControljointure = Sheets("SAISIE_ENTITE").Range("$CD$2")
     
    ' Gestion des conditions
     If CellVerifSaisie.Value = 35 Then
        MsgBox "l'entité va être saisie"
          Call UNPROTECTION_ONGLET("bdd_contact.xlsx", "bdd_entite")
          Call UNPROTECTION_ONGLET("bdd_contact.xlsx", "jointure_entite_contact")
          Call SAVE_ENTITE("SAISIE_ENTITE")
                If CellControljointure = 1 Then
                ' On enregistre la jointure entre la nouvelle entité et le contact déjà existante
                  Call SAVE_JOINTURE("SAISIE_ENTITE")
                End If
          Call PROTECTION_ONGLET("bdd_contact.xlsx", "bdd_entite")
          Call PROTECTION_ONGLET("bdd_contact.xlsx", "jointure_entite_contact")
     
    ElseIf CellVerifSaisie.Value = 26 Then
        MsgBox "le contact va être saisie"
         Call UNPROTECTION_ONGLET("bdd_contact.xlsx", "bdd_contact")
         Call UNPROTECTION_ONGLET("bdd_contact.xlsx", "jointure_entite_contact")
         Call SAVE_CONTACT("SAISIE_ENTITE")
                 If CellControljointure = 1 Then
                 ' On enregistre la jointure entre le nouveau contact et l'entité déjà existante
                Call SAVE_JOINTURE("SAISIE_ENTITE")
                End If
         Call PROTECTION_ONGLET("bdd_contact.xlsx", "bdd_contact")
         Call PROTECTION_ONGLET("bdd_contact.xlsx", "jointure_entite_contact")
     
    ElseIf CellVerifSaisie.Value = 25 Then
       Call verif_saisie_entite(CellVerifSaisieEntite)
       Call verif_saisie_contact(CellVerifSaisieContact)
          MsgBox "le contact et l'entité vont être saisie"
         Call UNPROTECTION_ONGLET("bdd_contact.xlsx", "bdd_contact")
         Call UNPROTECTION_ONGLET("bdd_contact.xlsx", "bdd_entite")
         Call UNPROTECTION_ONGLET("bdd_contact.xlsx", "jointure_entite_contact")
         Call SAVE_CONTACT("SAISIE_ENTITE")
         Call SAVE_ENTITE("SAISIE_ENTITE")
         ' On enregistre la jointure entre le nouveau contact et l'entité
           Call SAVE_JOINTURE("SAISIE_ENTITE")
          Call PROTECTION_ONGLET("bdd_contact.xlsx", "bdd_contact")
          Call PROTECTION_ONGLET("bdd_contact.xlsx", "bdd_entite")
          Call PROTECTION_ONGLET("bdd_contact.xlsx", "jointure_entite_contact")
        '
     
        ' code 36 ok jusqu'à la fin de la macro
    ElseIf CellVerifSaisie.Value = 36 Then
         MsgBox "rien n'est saisie"
        MsgBox "Aucune saisie n'est effectuée, car l'entité et le contact sont déjà existant"
       '  ' rien n'est enregistré
        '
     
    Else
    Call verif_saisie_entite(CellVerifSaisieEntite)
    Call verif_saisie_contact(CellVerifSaisieContact)
     
    End If
    Range("$AA$20").Select
    Selection.ClearContents
    MsgBox "c'est fini"
    Windows("Module_contact.xlsm").Activate
    Sheets("SAISIE_ENTITE").Select
    Range("$e$11").Select
     
    End Sub
    Voici maintenant les sous-programmes

    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
    Sub SAVE_CONTACT(OngletName)
     
    Windows("Module_contact.xlsm").Activate
    Sheets(OngletName).Select
    Range("BA2:BV2").Select
    Selection.Copy
     
    Windows("bdd_contact.xlsx").Activate
    Sheets("bdd_contact").Select
    Range("a10000").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                      False, Transpose:=False
    Range("a:z").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End Sub
    Sub SAVE_ENTITE(OngletName)
     
    Windows("Module_contact.xlsm").Activate
    Sheets(OngletName).Select
    Range("AA2:AV2").Select
    Selection.Copy
    Windows("bdd_contact.xlsx").Activate
    Sheets("bdd_entite").Select
    Range("a10000").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                      False, Transpose:=False
    Range("a:z").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End Sub
    Sub SAVE_JOINTURE(OngletName)
     
    Windows("Module_contact.xlsm").Activate
    Sheets(OngletName).Select
    Range("CA2:CC2").Select
    Selection.Copy
    Windows("bdd_contact.xlsx").Activate
    Sheets("jointure_entite_contact").Select
    Range("a10000").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                      False, Transpose:=False
    Range("a:c").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Application.EnableEvents = True
    End Sub
     
    Sub UNPROTECTION_ONGLET(FichierName, OngletName)
    '
        Windows(FichierName).Activate
        ActiveWorkbook.Worksheets(OngletName).Unprotect Password:="xxx"
    End Sub
    Sub PROTECTION_ONGLET(FichierName, OngletName)
    '
        Windows(FichierName).Activate
        ActiveWorkbook.Worksheets(OngletName).Protect Password:="xxx"
        ActiveWorkbook.Save
    End Sub
    Et voilà, j'ai tout mis.

    Merci de tes (et vos) retours (à tous) car grâce à vous je m'améliore... la preuve... étant autodidacte en VB et Macro, je tente d'apprendre vite, mais je sais aussi que je ne suis pas optimal.

    Citation Envoyé par mercatog Voir le message
    Pour le titre, il y a toujours une (des) raison(s) qui engendre(nt) le problème rencontré.
    Tu as raisons pour cela... il est évident qu'il y a une raison... large sourire ! la preuve.

  4. #4
    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
    Une petite précision, ta macro est dans quel classeur, module_contact ou bdd_contact.
    Si ta macro est dans le Classeur 1, comment est ouvert le classeur 2, manuellement ou par macro?

    [EDIT]
    Par hasard, essaies comme ceci (les procédures Verif_Saisie_XX n'ont pas été vérifiées)

    PS: Les précisions demandées au début restent sans réponse.

    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
    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
     
    Sub SAISIE_ENTITE()
    Dim Sh As Workbook
    Dim cCJ As Range, cVS As Range, cVSE As Range, cVSC As Range
     
    Set Sh = Workbooks("Module_contact.xlsm").Worksheets("SAISIE_ENTITE")
    With Sh
        Set cVSC = .Range("AA15")
        Set cVSE = .Range("AA16")
        Set cVS = .Range("AA18")
        Set cCJ = .Range("CD2")
     
        Select Case cVS.Value
            Case 35
                MsgBox "l'entité va être saisie"
                Call SAVE_INFO(Sh, 1)
                If cCJ = 1 Then Call SAVE_INFO(Sh, 2)
            Case 26
                MsgBox "le contact va être saisie"
                Call SAVE_INFO(Sh, 0)
                If cCJ = 1 Then Call SAVE_INFO(Sh, 2)
            Case 25
                Call Verif_Saisie_Entite(cVSE)
                Call Verif_Saisie_Contact(cVSC)
                MsgBox "le contact et l'entité vont être saisie"
                Call SAVE_INFO(Sh, 0)
                Call SAVE_INFO(Sh, 1)
                Call SAVE_INFO(Sh, 2)
            Case 36
                MsgBox "Rien n'est saisi"
                MsgBox "Aucune saisie n'est effectuée, Entité et Contact existent déjà"
            Case Else
                Call Verif_Saisie_Entite(cVSE)
                Call Verif_Saisie_Contact(cVSC)
        End Select
        .Range("AA20").ClearContents
    End With
    Set cVSC = Nothing
    Set cVSE = Nothing
    Set cVS = Nothing
    Set cCJ = Nothing
    Set Sh = Nothing
    MsgBox "c'est fini"
    End Sub
    'Le paramètre i a pour valeurs
    '0: Contact
    '1: Entité
    '2: Jointure
    Private Sub SAVE_INFO(ByVal WsSce As Worksheet, ByVal i As Byte)
    Dim Plage As String, WsDes As String
    Dim NewLig As Long
     
    Select Case i
        Case 0: Plage = "BA2:BV2": WsDes = "bdd_contact"
        Case 1: Plage = "AA2:AV2": WsDes = "bdd_entite"
        Case 2: Plage = "CA2:CC2": WsDes = "jointure_entite_contact"
    End Select
     
    If Plage <> "" Then
        UNPROTECTION_ONGLET WsDes
        WsSce.Range(Plage).Copy
        With Workbooks("bdd_contact.xlsx").Worksheets(WsDes)
            NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & NewLig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            .Range("A1:Z" & NewLig).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
        End With
        PROTECTION_ONGLET WsDes
    End If
    End Sub
     
     
    Private Sub UNPROTECTION_ONGLET(ByVal OngletName As String)
     
    Workbooks("bdd_contact.xlsx").Worksheets(OngletName).Unprotect Password:="xxx"
    End Sub
     
    Private Sub PROTECTION_ONGLET(ByVal OngletName As String)
     
    With Workbooks("bdd_contact.xlsx")
        .Worksheets(OngletName).Protect Password:="xxx", UserinterfaceOnly:=True
        .Save
    End With
    End Sub

  5. #5
    Membre éclairé Avatar de Giantrick
    Profil pro
    Inscrit en
    Janvier 2007
    Messages
    300
    Détails du profil
    Informations personnelles :
    Âge : 52
    Localisation : France

    Informations forums :
    Inscription : Janvier 2007
    Messages : 300
    Par défaut
    Citation Envoyé par mercatog Voir le message
    Une petite précision, ta macro est dans quel classeur, module_contact ou bdd_contact.
    Si ta macro est dans le Classeur 1, comment est ouvert le classeur 2, manuellement ou par macro?
    Oui les macros sont dans le classeur 1 (module_contact).
    et le classeur 2 s'ouvre automatiquement avec une macro dès l'ouverture du classeur 1.

    Citation Envoyé par mercatog Voir le message
    [EDIT]
    Par hasard, essaies comme ceci (les procédures Verif_Saisie_XX n'ont pas été vérifiées)
    ok pas de souci pour celles-là.

    Citation Envoyé par mercatog Voir le message
    PS: Les précisions demandées au début restent sans réponse.
    Quelles questions ?

    Pour le code que tu m'as mis, je vais le tester et reviens vers toi.

    MISE À JOUR : 15h54
    La macro se bloque sur la ligne 4
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set Sh = Workbooks("Module_contact.xlsm").Worksheets("SAISIE_ENTITE")

  6. #6
    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
    Oups, Sh est une variable Worksheet. En plus, depuis ta précision, essaies le début comme ceci
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    Sub SAISIE_ENTITE()
    Dim Sh As Worksheet
    Dim cCJ As Range, cVS As Range, cVSE As Range, cVSC As Range
     
    Set Sh = ThisWorkbook.Worksheets("SAISIE_ENTITE")
    '...la suite sans changement

  7. #7
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 093
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 093
    Billets dans le blog
    20
    Par défaut
    Salut
    Quand tu dis qu elle s interrompt se bloque , tu as un message d erreur ? C est quoi les symptômes ?
    Have a nice day. Oliv'
    Votre réponse est peut être dans mon blog !
    https://www.developpez.net/forums/blogs/191381-oliv-/

  8. #8
    Membre éclairé Avatar de Giantrick
    Profil pro
    Inscrit en
    Janvier 2007
    Messages
    300
    Détails du profil
    Informations personnelles :
    Âge : 52
    Localisation : France

    Informations forums :
    Inscription : Janvier 2007
    Messages : 300
    Par défaut
    Merci mercatog, au moins la macro fonctionne pour le début.

    Citation Envoyé par Oliv- Voir le message
    Salut
    Quand tu dis qu elle s interrompt se bloque , tu as un message d erreur ? C est quoi les symptômes ?
    Mais j'ai toujours le même souci.

    Pas de message d'erreur, mais la macro s'arrête après la première recopie que ce soit en code 35 ou 26 ou autre, et arrête l'exécution de la macro avant le tri. Elle n'exécute plus la suite.

    Comme si il y avait un "END" (ce qui n'est pas le cas) ou bien que la mémoire du presse papier est pleine ou autre ?

  9. #9
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 093
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 093
    Billets dans le blog
    20
    Par défaut
    Est ce que CellControljointure est bien = 1 ?
    Have a nice day. Oliv'
    Votre réponse est peut être dans mon blog !
    https://www.developpez.net/forums/blogs/191381-oliv-/

  10. #10
    Membre éclairé Avatar de Giantrick
    Profil pro
    Inscrit en
    Janvier 2007
    Messages
    300
    Détails du profil
    Informations personnelles :
    Âge : 52
    Localisation : France

    Informations forums :
    Inscription : Janvier 2007
    Messages : 300
    Par défaut
    Citation Envoyé par Oliv- Voir le message
    Est ce que CellControljointure est bien = 1 ?
    Oui c'est le cas

  11. #11
    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
    Montre aussi le code pour Verif_Saisie_Entite et Verif_Saisie_Contact

  12. #12
    Membre éclairé Avatar de Giantrick
    Profil pro
    Inscrit en
    Janvier 2007
    Messages
    300
    Détails du profil
    Informations personnelles :
    Âge : 52
    Localisation : France

    Informations forums :
    Inscription : Janvier 2007
    Messages : 300
    Par défaut
    Citation Envoyé par mercatog Voir le message
    Montre aussi le code pour Verif_Saisie_Entite et Verif_Saisie_Contact
    C'est juste un message box pour faire une vérif que l'on peut supprimer pour la résolution du problème car si on ne met pas les lignes

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Case Else
               Call verif_saisie_entite(cVSE)
               Call verif_saisie_contact(cVSC)
    Alors le même souci se produit : arrêt de la macro, comme ci-dessus indiquez, sans message d'erreur.

    Voici pour information le contenu des codes
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    Sub verif_saisie_entite(CellVerifSaisieEntite)
     
    If CellVerifSaisieEntite = 0 Then
                MsgBox "l'entité ne peut pas être saisie car vous n'avez rien saisie comme entité"
        End
    End If
    End Sub
    Sub verif_saisie_contact(CellVerifSaisieContact)
     
    If CellVerifSaisieContact = 0 Then
                MsgBox "le contact ne peut pas être saisie car vous n'avez rien saisie comme nom ou prénom"
        End
    End If
    End Sub

  13. #13
    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
    Teste ceci
    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
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    Option Explicit
     
    Sub SAISIE_ENTITE()
    Dim cCJ As Integer, CVS As Integer, cVSE As Integer, cVSC As Integer
    Dim Sh As Worksheet
     
    Set Sh = ThisWorkbook.Worksheets("SAISIE_ENTITE")
    With Sh
        cVSC = Val(.Range("AA15").Value)
        cVSE = Val(.Range("AA16").Value)
        CVS = Val(.Range("AA18").Value)
        cCJ = Val(.Range("CD2").Value)
     
        Select Case CVS
            Case 35
                MsgBox "l'entité va être saisie"
                Call SAVE_INFO(Sh, 1)
                If cCJ = 1 Then Call SAVE_INFO(Sh, 2)
            Case 26
                MsgBox "le contact va être saisi"
                Call SAVE_INFO(Sh, 0)
                If cCJ = 1 Then Call SAVE_INFO(Sh, 2)
            Case 25
                If Not Verif_Saisie(cVSE, 0) And Not Verif_Saisie(cVSC, 1) Then
                    MsgBox "le contact et l'entité vont être saisie"
                    Call SAVE_INFO(Sh, 0)
                    Call SAVE_INFO(Sh, 1)
                    Call SAVE_INFO(Sh, 2)
                End If
            Case 36
                MsgBox "Rien n'est saisi" & vbNewLine & "Aucune saisie n'est effectuée, Entité et Contact existent déjà"
        End Select
        .Range("AA20").ClearContents
    End With
    Set Sh = Nothing
    Workbooks("bdd_contact.xlsx").Save
    MsgBox "Traitement terminé"
    End Sub
    'Le paramètre i a pour valeurs
    '0: Contact
    '1: Entité
    '2: Jointure
    Private Sub SAVE_INFO(ByVal WsSce As Worksheet, ByVal i As Byte)
    Dim Plage As String, WsDes As String
    Dim NewLig As Long
     
    Select Case i
        Case 0: Plage = "BA2:BV2": WsDes = "bdd_contact"
        Case 1: Plage = "AA2:AV2": WsDes = "bdd_entite"
        Case 2: Plage = "CA2:CC2": WsDes = "jointure_entite_contact"
    End Select
     
    If Plage <> "" Then
        UNPROTECTION_ONGLET WsDes
        WsSce.Range(Plage).Copy
        With Workbooks("bdd_contact.xlsx").Worksheets(WsDes)
            NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & NewLig).PasteSpecial Paste:=xlValues
            .Range("A1:Z" & NewLig).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
        End With
        PROTECTION_ONGLET WsDes
    End If
    End Sub
    'Ind: 0 Entité, 1 Contact
    Private Function Verif_Saisie(ByVal CVS As Integer, ByVal Ind As Byte) As Boolean
    Dim Msg As String
     
    If CVS = 0 Then
        Verif_Saisie = True
        Msg = IIf(Ind = 0, "l'entité ne peut pas être saisie car vous n'avez rien saisi comme entité", "e contact ne peut pas être saisie car vous n'avez rien saisie comme nom ou prénom")
        MsgBox Msg
    End If
    End Function
     
    Private Sub UNPROTECTION_ONGLET(ByVal OngletName As String)
     
    Workbooks("bdd_contact.xlsx").Worksheets(OngletName).Unprotect Password:="xxx"
    End Sub
     
    Private Sub PROTECTION_ONGLET(ByVal OngletName As String)
     
    Workbooks("bdd_contact.xlsx").Worksheets(OngletName).Protect Password:="xxx", UserinterfaceOnly:=True
    End Sub

  14. #14
    Membre éclairé Avatar de Giantrick
    Profil pro
    Inscrit en
    Janvier 2007
    Messages
    300
    Détails du profil
    Informations personnelles :
    Âge : 52
    Localisation : France

    Informations forums :
    Inscription : Janvier 2007
    Messages : 300
    Par défaut
    Quoi que l'on fasse, le script s'arrête toujours au même endroit :

    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
    Le paramètre i a pour valeurs
    '0: Contact
    '1: Entité
    '2: Jointure
    Private Sub SAVE_INFO(ByVal WsSce As Worksheet, ByVal i As Byte)
    Dim Plage As String, WsDes As String
    Dim NewLig As Long
     
    Select Case i
        Case 0: Plage = "BA2:BV2": WsDes = "bdd_contact"
        Case 1: Plage = "AA2:AV2": WsDes = "bdd_entite"
        Case 2: Plage = "CA2:CC2": WsDes = "jointure_entite_contact"
    End Select
     
    If Plage <> "" Then
        ''UNPROTECTION_ONGLET WsDes
        WsSce.Range(Plage).Copy
        With Workbooks("bdd_contact.xlsx").Worksheets(WsDes)
            NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & NewLig).PasteSpecial Paste:=xlValues
            .Range("A1:Z" & NewLig).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
        End With
        'PROTECTION_ONGLET WsDes
    End If
    End Sub
    Il s'arrête entre la ligne 17 et 18.
    J'ai tenté de changer les code (0,1,2) pour voir si cela changeait quelques choses, mais rien. Dès que l'on met deux fois dans le code
    peut importe la seconde variable le code débute sur le second sous-programme et s'arrête entre la ligne 17 et 18.

    NB : j'ai testé sur un PC windows XP avec un office 2007 et le programme s'arrête au même endroit. Donc c'est plus un souci lié au code qu'à la machine.
    Sur mon mac je tourne avec Snow Leopard et Excel 2011

    ps : j'ai testé en enlevant toutes les sauvegardes voir les déprotections et protections pour alleger le code, j'ai même testé uniquement avec le code 35 mais dès lors qu'il y a deux fois l'appel du sous programme il se bloque.

    par contre dès lors qu'on ne met qu'un appel de "call" le programme se termine totalement

  15. #15
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    Mars 2006
    Messages
    4 093
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : Mars 2006
    Messages : 4 093
    Billets dans le blog
    20
    Par défaut
    Je veux bien une copie de tes fichiers (sans données confidentielles bien sûr) pour tester, car il n'y a pas de raison évidente à tes pb, je penche pour une perte de variable.
    Have a nice day. Oliv'
    Votre réponse est peut être dans mon blog !
    https://www.developpez.net/forums/blogs/191381-oliv-/

  16. #16
    Membre éclairé Avatar de Giantrick
    Profil pro
    Inscrit en
    Janvier 2007
    Messages
    300
    Détails du profil
    Informations personnelles :
    Âge : 52
    Localisation : France

    Informations forums :
    Inscription : Janvier 2007
    Messages : 300
    Par défaut
    Citation Envoyé par Oliv- Voir le message
    Je veux bien une copie de tes fichiers (sans données confidentielles bien sûr) pour tester, car il n'y a pas de raison évidente à tes pb, je penche pour une perte de variable.
    J'ai testé en enlevant et vérifiant plein de macro qui étaient en trop. Et c'était une macro évènementielle qui interrompait le tout...

    Merci en tout cas pour le code et le temps, affaire résolu tout fonctionne bien et plus rapidement qu'avant.

    Merci.

    ps : le code que mercatog a corrigé ci-dessus est parfait. ENCORE MERCI

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

Discussions similaires

  1. [XL-2013] Problème macro qui BOUCLE sans raison
    Par tyndare36 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 10/11/2014, 14h36
  2. [XL-2003] exécution d'une macro qui appel un autre classeur sans raisons
    Par fllyann dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 28/03/2011, 10h38
  3. Page s'exécutant sans raison apparente
    Par j_bolduc dans le forum ASP
    Réponses: 4
    Dernier message: 23/02/2006, 15h33
  4. NET::FTP unknown error sans raison
    Par niocco dans le forum Modules
    Réponses: 11
    Dernier message: 29/06/2005, 20h21
  5. ma base gonfle sans raison !!!
    Par hiul dragonfel dans le forum Access
    Réponses: 6
    Dernier message: 20/06/2005, 10h00

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