Worksheet_SelectionChange l'emporte sur Worksheet_Change

Le 10/11/2021 à 17:12

Bonjour

j'ai deux macro dans un meme onglet: Worksheet_SelectionChange et Worksheet_Change

le Worksheet_Change ne fonctionne pas une fois Worksheet_SelectionChange finit de s'executer

Le 10/11/2021 à 18:10
7extra-test.xlsm (37.49 Ko)
Le 11/11/2021 à 04:35

Bonjour Abdel39,

Mis à part le fait que votre façon de faire est très "étrange"

Vous faisiez un

Application.EnableEvents = False

Sans ensuite faire

Application.EnableEvents = True

Ce qui arrêtait les évènements

Ensuite imbrique des If... End If n'est absolument pas utile et complique la lecture du code

Voici votre fichier avec le code modifié

3abdel39-extra-test.xlsm (29.73 Ko)

A+

Le 12/11/2021 à 14:29

Bonjour

Merci pour votre implication. Cependant ca ne marche pas: metter des valeurs non numeriques dans e4, f4 ou g4 et vous allez voir le probleme. En effet si je rentre une valeur non numerique dans e4 le programme doit signaler l'erreur et doit retourner tant que la valeur dans e4 n'est pas numerique et ne doit pas poser la question voulez vous entrer un autre lot.

j'ai une solution provisoire lorsque 'il s'agit de trois cellule, mais lorsqu'il s'agit de plusieurs comme dans mon fichier d'origine, ca ne marche pas

Le 12/11/2021 à 14:34

Re,

Et bien j'ai ce message

image

Qui me semble normal puisqu'il vient de Worksheet_Change

A+

Le 12/11/2021 à 14:39

ci-joint la version provisoire dans l'Exemple simple qui a un defaut une fois je rentre une valeur non numerique du numero du lot du lot 3 aucune le programme ne me demande pas de reveni corriger la valeur non numerique

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim AnswerYes As Integer

  Application.ScreenUpdating = False
  If Worksheets("Timer").Cells(4, 16).Value > 1 _
    And Worksheets("Timer").Cells(14, 16).Value > 1 _
    And Worksheets("Timer").Cells(24, 16).Value > 1 _
    And Worksheets("Extra samples").Cells(4, 5).Value > 0 _
    And Worksheets("Extra samples").Cells(4, 6).Value > 0 _
    And Worksheets("Extra samples").Cells(4, 7).Value > 0 Then
    ' On sort
    Exit Sub
    ' Donc le IF peut s'arrêter là
  End If

  '========================Lot 1===============================
  If Worksheets("Timer").Cells(4, 16).Value = 1 Then
    Application.EnableEvents = False
    MsgBox ("Selectionner le Lot 1")
    Range("e3").Select
    GoTo Fin
  End If

  If Worksheets("Extra samples").Cells(4, 5).Value = 0 Or Not IsNumeric(Range("e4").Value) Then
    Application.EnableEvents = False
    MsgBox ("Enter la veleur numérique du numero du Lot 1")
    Range("e4").Select
    GoTo Fin
  End If
  '========================Lot 2===============================
  AnswerYes = MsgBox("Voulez-vous continuer pour selectionner un autre Lot?", vbQuestion + vbYesNo, "User Repsonse")
  If AnswerYes = vbNo Then Exit Sub

  If Worksheets("Timer").Cells(14, 16).Value = 1 Then
    Application.EnableEvents = False
    MsgBox ("Selectionner le Lot 2")
    Range("f3").Select
    GoTo Fin
  End If
  '============================================================
  If Worksheets("Extra samples").Cells(4, 6).Value = 0 Or Not IsNumeric(Range("f4").Value) Then
    Application.EnableEvents = False
    MsgBox ("Enter la veleur numérique du numero du Lot 2")
    Range("f4").Select
    GoTo Fin
  End If
  '========================Lot 3===============================
  If Worksheets("Timer").Cells(24, 16).Value = 1 Then
    Application.EnableEvents = False
    MsgBox ("Selectionner le Lot 3")
    Range("g3").Select
    GoTo Fin
  End If
  '============================================================
  If Worksheets("Extra samples").Cells(4, 7).Value = 0 Or Not IsNumeric(Range("g4").Value) Then
    Application.EnableEvents = False
    MsgBox ("Enter la veleur numérique du numero du Lot 3")
    Range("g4").Select
  End If

Fin:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub
1abdel39-extra-test1.xlsm (29.58 Ko)
Le 12/11/2021 à 15:22

Re,

Si j'ai tout bien compris, essayez ce fichier simplifié

3abdel39-extra-test-v2.xlsm (28.15 Ko)

A+

Le 12/11/2021 à 15:33

Dans ton nouveau fichier: les trois menus sont disparus, aucune obligation de remplir les cellules e4,f4 et g4 et aucune obligation de remplir e3,f3 et g3

il faut obliger l'utilisateur de selectionner le lot et de choisir son numero

essaye ceci qui reste presque parfait sauf pour le dernier lot (3) qui ne revient pas à la cellule g4 lorsqu'elle est non numerique (voir fichier joint)

2abdel39-extra-test1.xlsm (29.58 Ko)
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim AnswerYes As Integer

  Application.ScreenUpdating = False
  If Worksheets("Timer").Cells(4, 16).Value > 1 _
    And Worksheets("Timer").Cells(14, 16).Value > 1 _
    And Worksheets("Timer").Cells(24, 16).Value > 1 _
    And Worksheets("Extra samples").Cells(4, 5).Value > 0 _
    And Worksheets("Extra samples").Cells(4, 6).Value > 0 _
    And Worksheets("Extra samples").Cells(4, 7).Value > 0 Then
    ' On sort
    Exit Sub
    ' Donc le IF peut s'arrêter là
  End If

  '========================Lot 1===============================
  If Worksheets("Timer").Cells(4, 16).Value = 1 Then
    Application.EnableEvents = False
    MsgBox ("Selectionner le Lot 1")
    Range("e3").Select
    GoTo Fin
  End If

  If Worksheets("Extra samples").Cells(4, 5).Value = 0 Or Not IsNumeric(Range("e4").Value) Then
    Application.EnableEvents = False
    MsgBox ("Enter la veleur numérique du numero du Lot 1")
    Range("e4").Select
    GoTo Fin
  End If
  '========================Lot 2===============================
  AnswerYes = MsgBox("Voulez-vous continuer pour selectionner un autre Lot?", vbQuestion + vbYesNo, "User Repsonse")
  If AnswerYes = vbNo Then Exit Sub

  If Worksheets("Timer").Cells(14, 16).Value = 1 Then
    Application.EnableEvents = False
    MsgBox ("Selectionner le Lot 2")
    Range("f3").Select
    GoTo Fin
  End If
  '============================================================
  If Worksheets("Extra samples").Cells(4, 6).Value = 0 Or Not IsNumeric(Range("f4").Value) Then
    Application.EnableEvents = False
    MsgBox ("Enter la veleur numérique du numero du Lot 2")
    Range("f4").Select
    GoTo Fin
  End If
  '========================Lot 3===============================
  If Worksheets("Timer").Cells(24, 16).Value = 1 Then
    Application.EnableEvents = False
    MsgBox ("Selectionner le Lot 3")
    Range("g3").Select
    GoTo Fin
  End If
  '============================================================
  If Worksheets("Extra samples").Cells(4, 7).Value = 0 Or Not IsNumeric(Range("g4").Value) Then
    Application.EnableEvents = False
    MsgBox ("Enter la veleur numérique du numero du Lot 3")
    Range("g4").Select
  End If

Fin:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub
Rechercher des sujets similaires à "worksheet selectionchange emporte change"