XL 2021 Erreur d'exécution 424

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bjr à toutes et à tous 🙂

Je n'arrive pas à coder comme il faut et j'ai :
1707145778913.png

J'ai besoin que le code s'exécute si clic ligne active cellules de J à S
Auriez-vous le bon code ?
Un grand merci à toutes et à tous 🙂
 
Trier par date Trier par votes
sylvanu à dit:
Re,
C'est interdit tout simplement.
Il vous faut imbriquer les IF comme par ex :
VB: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("J:S")) Is Nothing Then
        MsgBox "ok"
    ElseIf Not Intersect(Target, Plage2) Is Nothing Then
        'Code2
    ElseIf Not Intersect(Target, Plage3) Is Nothing Then
        'Code3
    ElseIf Not Intersect(Target, Plage4) Is Nothing Then
        'Code4
    End If
End Sub
Cliquez pour agrandir...
Bon, je vais tenter de voir mais je ne sais pas faire ça.
🙂
 
Vote positif 0 Vote négatif
ok les voici :
Private Sub Worksheet_SelectionChange(ByVal R As Range)
VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    'If Not Intersect(R, Range("e6:s30000")) Is Nothing And R.Count = 1 Then
    If Not Intersect(R, Range("e6:s30000")) Is Nothing And R.CountLarge = 1 Then
        Application.EnableEvents = False
        [x2] = 0
        [x2].FormulaR1C1 = "=RIGHT(R[-1]C[-14],1)"
        Calculate
        If [x2] <> "K" Then
            ActiveSheet.Cells(Rows.Count, "e").End(xlUp)(1).Select
        'Rows("7:30000").RowHeight = 0
            Else
            [x2] = 0
            'Rows("7:30000").RowHeight = 50
        End If
        Application.EnableEvents = True
    End If

    If Not Intersect(R, Range("g6:h30000")) Is Nothing And R.Count = 1 Then
    If R <> "" Then
        If MsgBox("      Vous appelez ?" & Chr(10) & Chr(10) & "OUI         ou        NON", vbQuestion + vbYesNo) <> vbYes Then
        Cells(ActiveCell.Row, 5).Activate
        Application.CutCopyMode = False
        Exit Sub
        End If
        ActiveCell.Name = "MaCell" 'nomme la cellule
        Cells(ActiveCell.Row, 5).FormulaR1C1 = "=TODAY()"
        Cells(ActiveCell.Row, 5).Value = Cells(ActiveCell.Row, 5).Value
        Cells(ActiveCell.Row, 12).ClearContents
        R.Copy
        Cells(ActiveCell.Row, 5).Activate
        Exit Sub
        End If
    End If

    If Not Intersect(R, Range("l6:l30000")) Is Nothing And R.Count = 1 Then
        If Cells(ActiveCell.Row, 7) = "" Then
            Application.EnableEvents = False
            Cells(ActiveCell.Row, 5).Select
                MsgBox ("Manque N° Tel")
            Application.EnableEvents = True
            Exit Sub
        End If
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    affectations.Show

If Cells(ActiveCell.Row, 12) = "Répondeur" Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Cells(ActiveCell.Row, 13) = ""
    Cells(ActiveCell.Row, 13).FormulaR1C1 = "=TODAY()+5"
    Cells(ActiveCell.Row, 13).Value = Cells(ActiveCell.Row, 13).Value
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End If

    If Cells(ActiveCell.Row, 12) = "A Rappeler" Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Cells(ActiveCell.Row, 13) = ""
    Cells(ActiveCell.Row, 14) = ""
    Cells(ActiveCell.Row, 15) = ""
    fm_CalendrierCellMinMax.Show

    If Cells(ActiveCell.Row, 13) = "" Then
    MsgBox ("Il faut sélectionner une date de rappel avant de quitter le calendrier")
    fm_CalendrierCellMinMax.Show
    End If

    Cells(ActiveCell.Row, 20).FormulaR1C1 = "=IF(OR(R[-2]C[-13]="""",RC[-10]=""""),0,IF(AND(RC[-7]>0,RC[-7]<TODAY()+1),""R"",0))"
    Cells(ActiveCell.Row, 21).FormulaR1C1 = "=IF(RC[-1]=""R"",""Appelez vite"","""")"
    Cells(ActiveCell.Row, 20).Value = Cells(ActiveCell.Row, 20).Value
    Cells(ActiveCell.Row, 21).Value = Cells(ActiveCell.Row, 21).Value
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End If

    If Cells(ActiveCell.Row, 12) <> "" Then 'si L vide
        tableau_client = ThisWorkbook.Sheets("ClientsCoordonnées").Range("Clients").Value
        ActiveSheet.Cells(ActiveCell.Row, 16).Value = rechercher_tab(tableau_client, Cells(ActiveCell.Row, 10), 3, 1) & " " & rechercher_tab(tableau_client, ActiveSheet.Cells(ActiveCell.Row, 10), 4, 1)
    Cells(ActiveCell.Row, 5).Select
    End If
    End If

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    If Not Intersect(R, Range("m6:m30000")) Is Nothing And R.Count = 1 Then
     MsgBox ("Pour mettre ou changer la date de rappel, il faut réaffecter")
     Cells(ActiveCell.Row, 1).Select
     Exit Sub
     End If

    If Not Intersect(R, Range("r6:r30000")) Is Nothing And R.Count = 1 Then
    If [x2] > 0 Then: Exit Sub
        R.Activate
        If R <> "" Then
            If MsgBox("Lien déjà présent : modifier ?" & Chr(10) & Chr(10) & "     OUI         ou        NON", vbQuestion + vbYesNo) <> vbYes Then
            Exit Sub
            End If
        End If
        lien
    End If

    If Not Intersect(R, Range("s6:s30000")) Is Nothing And R.Count = 1 Then
    If [x2] > 0 Then: Exit Sub
        If R <> "" Then
            If MsgBox("Annonce déjà présente : modifier ?" & Chr(10) & Chr(10) & "                 OUI         ou        NON", vbQuestion + vbYesNo) <> vbYes Then
            Exit Sub
            End If
        End If
        annonce
    End If

End Sub
Target
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J6:J30000")) Is Nothing Then
    If Cells(ActiveCell.Row, 12) <> "" Then 'si L vide
        tableau_client = ThisWorkbook.Sheets("ClientsCoordonnées").Range("Clients").Value
        ActiveSheet.Cells(ActiveCell.Row, 16).Value = rechercher_tab(tableau_client, Cells(ActiveCell.Row, 10), 3, 1) & " " & rechercher_tab(tableau_client, ActiveSheet.Cells(ActiveCell.Row, 10), 4, 1)
    End If
End If

Dim temp, entree As String
Dim macellule As Range
If Application.Intersect(Target, Range("$G$3:$H$30000")) Is Nothing Then Exit Sub
Application.MoveAfterReturn = False
For Each macellule In Target
    temp = ""

    If Not Application.Intersect(macellule, Range("$G$6:$G$30000")) Is Nothing Then
    Application.MoveAfterReturn = False
        'If Target.Count > 1 Then Exit Sub 'sortie si plusieurs cellules
        'If macellule.Value = "" Then Exit Sub 'sortie si vide
        If Left(macellule.Value, 2) = "33" And Len(macellule.Value) = 11 Then Exit Sub 'sortie si commence par 33
        entree = macellule.Value
        For I = 1 To Len(macellule.Value) 'boucle jusqu'à fin de mot
            If IsNumeric(Mid(entree, I, 1)) Then temp = temp & Mid(entree, I, 1)  'si caractère non numérique alors ajoute espace
        Next I
        If Left(temp, 1) = "0" Then temp = Right(temp, Len(temp) - 1)
        If Len(temp) <> 9 Then
            MsgBox "numéro invalide refaire votre saisie" & entree & "-" & temp
            'ActiveCell.Offset(0, 0).Select
            Target.FormulaR1C1 = ""
            Target.Select
        Else
            Application.EnableEvents = False
            ActiveSheet.Unprotect Password:=""
            macellule.Value = "33" & temp
        End If
    End If

    If Not Application.Intersect(macellule, Range("$H$6:$H$30000")) Is Nothing Then
    Application.MoveAfterReturn = False
        'If Target.Count > 1 Then Exit Sub 'sortie si plusieurs cellules
        'If macellule.Value = "" Then Exit Sub 'sortie si vide
        If Left(macellule.Value, 2) = "33" And Len(macellule.Value) = 11 Then Exit Sub 'sortie si commence par 33
        entree = macellule.Value
        For I = 1 To Len(macellule.Value) 'boucle jusqu'à fin de mot
            If IsNumeric(Mid(entree, I, 1)) Then temp = temp & Mid(entree, I, 1)  'si caractère non numérique alors ajoute espace
        Next I
        If Left(temp, 1) = "0" Then temp = Right(temp, Len(temp) - 1)
        If Len(temp) <> 9 Then
            MsgBox "numéro invalide refaire votre saisie" & entree & "-" & temp
            'ActiveCell.Offset(0, 0).Select
            Target.FormulaR1C1 = ""
            Target.Select
        Else
            Application.EnableEvents = False
            macellule.Value = "33" & temp
        End If
    End If
Next

    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.MoveAfterReturn = True
    Cells(1, 29) = Target.Value
    Cells(2, 29) = "x"
End Sub
Si vous vous demandez : ça fonctionne ça ??? hé ben oui lol
Merci de ne pas vous moquer lol
🙂
 
Vote positif 0 Vote négatif
Lionel,
C'est pareil qu'expliqué au post #15.
Seulement dans votre cas il va parcourir tous les IF alors qu'avec des IF ELSEIF dès qu'il trouvera la bonne correspondance il la traitera et sortira sans se préoccuper des autres plages.
Mais si ce genre d'écriture vous va, elle marche impeccable. 🙂
 
Vote positif 0 Vote négatif
J'ai tout simplement tenté ça :
VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    If Not Intersect(R, Range("e6:s30000")) Is Nothing And R.CountLarge = 1 Then
    If R = Cells(ActiveCell.Row, 10) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 11) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 12) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 13) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 16) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 17) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 18) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 19) Then: Exit Sub
Il faudrait juste que ça bloque l'exécution de la suite du code, soit :
Code: 
       Application.EnableEvents = False
        [x2] = 0
        [x2].FormulaR1C1 = "=RIGHT(R[-1]C[-14],1)"
        Calculate
        If [x2] <> "K" Then
            ActiveSheet.Cells(Rows.Count, "e").End(xlUp)(1).Select
        'Rows("7:30000").RowHeight = 0
            Else
            [x2] = 0
            'Rows("7:30000").RowHeight = 50
        End If
        Application.EnableEvents = True
    End If
Mais ça me bloque l'exécution des codes suivants qui doivent s'éxécuter quand clic sur certaines cellules de la ligne.
 
Dernière édition:
Vote positif 0 Vote négatif
Effectivement, je voudrais que :
VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    If Not Intersect(R, Range("e6:s30000")) Is Nothing And R.CountLarge = 1 Then
    If R = Cells(ActiveCell.Row, 10) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 11) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 12) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 13) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 16) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 17) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 18) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 19) Then: Exit Sub
Me bloque le code jusque-là :
Code: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    If Not Intersect(R, Range("e6:s30000")) Is Nothing And R.CountLarge = 1 Then
    If R = Cells(ActiveCell.Row, 10) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 11) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 12) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 13) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 16) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 17) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 18) Then: Exit Sub
    If R = Cells(ActiveCell.Row, 19) Then: Exit Sub

        Application.EnableEvents = False
        [x2] = 0
        [x2].FormulaR1C1 = "=RIGHT(R[-1]C[-14],1)"
        Calculate
        If [x2] <> "K" Then
            ActiveSheet.Cells(Rows.Count, "e").End(xlUp)(1).Select
        'Rows("7:30000").RowHeight = 0
            Else
            [x2] = 0
            'Rows("7:30000").RowHeight = 50
        End If
        Application.EnableEvents = True
    End If
mais ne bloque pas tout le code qui suit, me permettant ainsi d'exécuter les codes suivants qui doivent s'éxécuter quand clic sur certaines cellules de la ligne active.
🙂
 
Vote positif 0 Vote négatif
Si j'ai bien compris, la première partie ne se fait pas si les colonnes sont entre 11 et 19. Le problème s'est qu'un Exit sub sort complétement de la macro.
Donc on peut faire le contraire :
Si la colonnes est <11 ou >19 on fait le code, sinon on poursuit. Dans ce cas il n'y a plus d'Exit sub.
VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    If Not Intersect(R, Range("e6:s30000")) Is Nothing And R.CountLarge = 1 Then
    If R.Column <= 10 Or R.Column >= 20 Then ' Donc on exclut les colonnes de 10 à 19
        Application.EnableEvents = False
        [x2] = 0
        [x2].FormulaR1C1 = "=RIGHT(R[-1]C[-14],1)"
        Calculate
        If [x2] <> "K" Then
            ActiveSheet.Cells(Rows.Count, "e").End(xlUp)(1).Select
            Else
            [x2] = 0
        End If
        Application.EnableEvents = True
    End If
    ' Sinon on fait la suite
    ' ....  suite du code
 
Vote positif 0 Vote négatif
Bonsoir @Usine à gaz

' Erreur
VB: 
Private Sub Worksheet SelectionChange (ByVal R as Range)
     If Intersect (Active.Row, Range("j:s")) Is Nothing Then Exit Sub

' Correction
' A) Vous devriez utiliser Target.Row au lieu de Active.Row
' - De plus, vous pourriez vouloir spécifier les colonnes de la plage plutôt que de simplement mentionner les lettres.
' B) Dans cette version corrigée :
- Target.EntireRow est utilisé pour vérifier si la rangée sélectionnée (au lieu de la cellule) fait partie de la plage spécifiée (colonnes J à S).
- Cela permet de vérifier si la sélection est dans la plage J:S. Vous pouvez ensuite ajouter votre code à exécuter à l'intérieur de la procédure
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target.EntireRow, Range("J:S")) Is Nothing Then Exit Sub
    ' Votre code à exécuter ici
End Sub
 
Vote positif 0 Vote négatif
sylvanu à dit:
Si j'ai bien compris, la première partie ne se fait pas si les colonnes sont entre 11 et 19. Le problème s'est qu'un Exit sub sort complétement de la macro.
Donc on peut faire le contraire :
Si la colonnes est <11 ou >19 on fait le code, sinon on poursuit. Dans ce cas il n'y a plus d'Exit sub.
VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
    If Not Intersect(R, Range("e6:s30000")) Is Nothing And R.CountLarge = 1 Then
    If R.Column <= 10 Or R.Column >= 20 Then ' Donc on exclut les colonnes de 10 à 19
        Application.EnableEvents = False
        [x2] = 0
        [x2].FormulaR1C1 = "=RIGHT(R[-1]C[-14],1)"
        Calculate
        If [x2] <> "K" Then
            ActiveSheet.Cells(Rows.Count, "e").End(xlUp)(1).Select
            Else
            [x2] = 0
        End If
        Application.EnableEvents = True
    End If
    ' Sinon on fait la suite
    ' ....  suite du code
Cliquez pour agrandir...
Bsr sylvanu 🙂
Grand merci pour ta ténacité.
Aux 1ers tests, il semble que cela fonctionne.
Je dois faire d'autres tests mais trop fatigué pour ce soir.
Merci beaucoup pour tout ce que tu fais.
Bonne nuit,
lionel 🙂
 
Vote positif 0 Vote négatif
laurent950 à dit:
Bonsoir @Usine à gaz

' Erreur
VB: 
Private Sub Worksheet SelectionChange (ByVal R as Range)
     If Intersect (Active.Row, Range("j:s")) Is Nothing Then Exit Sub

' Correction
' A) Vous devriez utiliser Target.Row au lieu de Active.Row
' - De plus, vous pourriez vouloir spécifier les colonnes de la plage plutôt que de simplement mentionner les lettres.
' B) Dans cette version corrigée :
- Target.EntireRow est utilisé pour vérifier si la rangée sélectionnée (au lieu de la cellule) fait partie de la plage spécifiée (colonnes J à S).
- Cela permet de vérifier si la sélection est dans la plage J:S. Vous pouvez ensuite ajouter votre code à exécuter à l'intérieur de la procédure
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target.EntireRow, Range("J:S")) Is Nothing Then Exit Sub
    ' Votre code à exécuter ici
End Sub
Cliquez pour agrandir...
Bonsoir Laurent,
Merci d'être là toi aussi mais on a déjà tenté "
Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
Cliquez pour agrandir...

1707172210946.png

ça beugue car j'utilise déjà change cf photo ci-dessus.

Il semble que Sylvanu ait trouvé le bon code, cf #post 24.
Je poursuis demain
Bonne nuit,
lionel 🙂
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

ARaul
  • Question Question
XL 2019 Erreur d'exécution "13"
Réponses
1
Affichages
295
sylvanu
sylvanu
treza88
  • Question Question
XL 2021 Réduction temps d'exécution boucle macro
Réponses
11
Affichages
350
TooFatBoy
TooFatBoy
B
  • Question Question
Microsoft 365 Erreur d'exécution 35600
Réponses
4
Affichages
485
Dranreb
Dranreb
M
  • Résolu(e)
Microsoft 365 Signature manuelle sur écran tactile
2
Réponses
27
Affichages
1 K
Marec
M
M
  • Question Question
XL 2021 Débogage VBA
2
Réponses
16
Affichages
503
TooFatBoy
TooFatBoy
G
  • Question Question
Microsoft 365 Formule sous condition
Réponses
2
Affichages
126
sylvanu
sylvanu
S
  • Question Question
Microsoft 365 Fichier Excel créer en VF : formules en erreur sur PC en italien
Réponses
6
Affichages
93
sylvanu
sylvanu
Usine à gaz
  • Question Question
Autres Ouverture classeur Excel au clic sur l'icône du classeur
Réponses
4
Affichages
106
Usine à gaz
Usine à gaz
PORCHER
  • Question Question
Microsoft 365 Erreur UBound
Réponses
4
Affichages
217
PORCHER
PORCHER
D
  • Question Question
XL 2013 Codage VBA
Réponses
6
Affichages
200
Oneida
Oneida
Usine à gaz
  • Résolu(e)
XL 2021 Cellule vide : sélectionner et atteindre
2
Réponses
15
Affichages
1 K
Usine à gaz
Usine à gaz
J
  • Question Question
Microsoft 365 Worksheet_Change ou Worksheet_Calculate
Réponses
9
Affichages
404
job75
job75
C
  • Résolu(e)
Autres Validation de données avant verrouillage de la ligne
2
Réponses
17
Affichages
249
com689
C
jcf6464
  • Résolu(e)
Microsoft 365 Trier sur colonnes disjointe sur 12 feuilles
Réponses
6
Affichages
243
jcf6464
jcf6464
Usine à gaz
  • Résolu(e)
XL 2021 Sélectionner plusieurs plages jusqu'à la dernière ligne NON vide en col "E"
Réponses
5
Affichages
362
Usine à gaz
Usine à gaz
J
  • Question Question
erreur de compilation
Réponses
6
Affichages
211
Jielgé
J
P
  • Résolu(e)
Microsoft 365 Power Pivot et mesure DAX
Réponses
7
Affichages
254
Pedro1111
P
F
  • Question Question
Microsoft 365 Course à pied : entrer catégorie selon date de naissance des participants ?
Réponses
5
Affichages
279
francoismougeot
F
M
  • Question Question
XL 2021 Erreur 424
Réponses
14
Affichages
1 K
Marie1608
M
treza88
  • Question Question
XL 2021 Copier coller qui ajoute une référence absolu Toute seule
2
Réponses
24
Affichages
914
TooFatBoy
TooFatBoy
Retour