Problème Création de modèle de saisie avec If Not Application.Intersect

Version imprimable

Bonsoir à toutes et à tous,

Encore merci pour votre accueil sur le forum et l'aide apportée sur mon précédent soucis.

Je reviens vers vous avec un tout nouveau problème.

Pour vous situer dans le contexte : Je travaille en comptabilité et je me suis créé un fichier de saisie semi-automatisé (cf. pièces jointes).
Ce fichier fonctionne très bien, j'y ai inséré des formules à chaque cellule et des macros automatiques en colonne A, B, D, E et F qui me permettent de venir me placer dans la bonne cellule à saisir à chaque tabulation. Mais je pense que nous pouvons encore l'améliorer en y insérant des modèles de saisie, en fonction de la valeur de D.
Par exemple : Lorsque je saisi un montant en cellule E1 ou F1 (en fonction de s'il s'agit d'un avoir ou d'une facture) et que la cellule D1 contient "BLEU" alors "lancement de codes qui renseigne les cellules D2 = TVA, E2 = F1/1,2*0,2, D3 = SANDWICH, E3 = F1-E2.

Mon problème est que lorsque mon code modifie les cellules des colonne D, E et F ma macro automatique (If Not Application.Intersect(Target, Range("E2:F1500")) Is Nothing Then) s'éxecute. J'aimerai la désactiver pendant que mon modèle de saisi s’exécute.

J'ai tenté d'utiliser Application.EnableEvents = False / True mais j'obtiens sans cesse des erreurs. Peut être que je ne le place pas au bon endroit.

Je vous ai joins mon fichier pour que vous puissiez visualiser mon problème, je ne pense pas être assez compréhensible dans ce message.

Je vous remercie d'avance pour votre temps.
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 Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Target, Range("E2:F1500")) Is Nothing Then Dim ligne As Integer With ActiveCell ligne = .Row End With If Cells(ligne, 12) = 0 Then Cells(ligne + 1, 1).Select Else: Cells(ligne + 1, 4).Select End If End If If Not Application.Intersect(Target, Range("B2:B1500")) Is Nothing Then With ActiveCell ligne = .Row End With Cells(ligne, 4).Select End If If Not Application.Intersect(Target, Range("D2:D1500")) Is Nothing Then With ActiveCell ligne = .Row End With On Error Resume Next If Cells(ligne, 9) = "401100000" And Not UCase(Left(Cells(ligne, 2), 1)) = "A" Then Cells(ligne, 6).Select Else: If Cells(ligne, 12) < 0 Then Cells(ligne, 6).Select End If End If End Sub

25/07/2017, 21h54
jerome.vaussenat
Salut,

Tu peux momentanément désactiver les événements avec les instructions suivantes :
Code:

1 2 3 4 5 6 7 8 Sub pas_d_evenement() Application.EnableEvents = False '... Application.EnableEvents = True End Sub
Pense bien à les réactiver à la fin de ton code !

En espérant que c'est bien ce que tu veux.
26/07/2017, 01h04
Naunaud59

Salut Jérôme, le problème c'est que je ne sais pas où je dois placer ce code pour qu'il fonctionne.
26/07/2017, 01h34
eriiic

Bonjour,

avant d'écrire dans une des cellules supervisées : Range("E2:F1500"), Range("B2:B1500") etc
et tu rétablis ensuite.
eric

Bonjour,

Un grand merci !

Mon code fonctionne parfaitement grâce à vos explications et j'ai réussi à comprendre l'utilisation de Application.EnableEvents .

J'ai une nouvelle question à vous soumettre si vous me le permettez? Dans la continuité de mon projet j'obtiens ce code et j'aimerai savoir s'il existe un moyen de l'alléger (puisque je risque d'avoir encore d'autres valeurs à ajouter) :

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
44
45
46
47
48
49
50
51
52
53
Private Sub Worksheet_Change(ByVal Target As Range)
 
 If Not Application.Intersect(Target, Range("E2:F1500")) Is Nothing Then
 
   Dim ligne As Integer
 
  With ActiveCell
    ligne = .Row
  End With
 
 If Cells(ligne, 4).Value Like "DAUNAT" Then
 
 If Cells(ligne, 12) < 0 Then
 
  Application.EnableEvents = False
 Cells(ligne + 1, 4).FormulaR1C1 = "TVA"
 Cells(ligne + 1, 6).FormulaR1C1 = "=ROUND(R[-1]C[-1]/1.055*0.055,2)"
 Cells(ligne + 2, 4).FormulaR1C1 = "SANDWICH"
 Cells(ligne + 2, 6).FormulaR1C1 = "=R[-2]C[-1]-R[-1]C"
 Application.EnableEvents = True
 Cells(ligne + 3, 1).Select
Else
 Application.EnableEvents = False
 Cells(ligne + 1, 4).FormulaR1C1 = "TVA"
 Cells(ligne + 1, 5).FormulaR1C1 = "=ROUND(R[-1]C[1]/1.055*0.055,2)"
 Cells(ligne + 2, 4).FormulaR1C1 = "SANDWICH"
 Cells(ligne + 2, 5).FormulaR1C1 = "=R[-2]C[1]-R[-1]C"
 Application.EnableEvents = True
 Cells(ligne + 3, 1).Select
End If
 
Else
 
 If Cells(ligne, 4).Value Like "MIKO" Then
 
 If Cells(ligne, 12) < 0 Then
 
  Application.EnableEvents = False
 Cells(ligne + 1, 4).FormulaR1C1 = "TVA"
 Cells(ligne + 1, 6).FormulaR1C1 = "=ROUND(R[-1]C[-1]/1.055*0.055,2)"
 Cells(ligne + 2, 4).FormulaR1C1 = "ICE CREAM"
 Cells(ligne + 2, 6).FormulaR1C1 = "=R[-2]C[-1]-R[-1]C"
 Application.EnableEvents = True
 Cells(ligne + 3, 1).Select
Else
 Application.EnableEvents = False
 Cells(ligne + 1, 4).FormulaR1C1 = "TVA"
 Cells(ligne + 1, 5).FormulaR1C1 = "=ROUND(R[-1]C[1]/1.055*0.055,2)"
 Cells(ligne + 2, 4).FormulaR1C1 = "ICE CREAM"
 Cells(ligne + 2, 5).FormulaR1C1 = "=R[-2]C[1]-R[-1]C"
 Application.EnableEvents = True
 Cells(ligne + 3, 1).Select
End If

Comme vous le constatez il n'y a que deux éléments qui changent dans mon second code : "MIKO" et "ICE CREAM" . Pour regrouper les deux codes je pensais utiliser le code suivant pour la première étape mais je bloque pour que "ICE CREAM" corresponde bien à MIKO uniquement.

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
If Not Application.Intersect(Target, Range("E2:F1500")) Is Nothing Then
 
   Dim ligne As Integer
 
  With ActiveCell
    ligne = .Row
  End With
 
 If Cells(ligne, 4).Value Like "DAUNAT" or If Cells(ligne, 4).Value Like "MIKO" Then
 
 If Cells(ligne, 12) < 0 Then
 
  Application.EnableEvents = False
 Cells(ligne + 1, 4).FormulaR1C1 = "TVA"
 Cells(ligne + 1, 6).FormulaR1C1 = "=ROUND(R[-1]C[-1]/1.055*0.055,2)"
'ici il me faut rajouter "ICE CREAM" pour que si valeur = MIKO alors ICE CREAM et non pas SANDWICH.
 Cells(ligne + 2, 4).FormulaR1C1 = "SANDWICH"
 Cells(ligne + 2, 6).FormulaR1C1 = "=R[-2]C[-1]-R[-1]C"
 Application.EnableEvents = True
 Cells(ligne + 3, 1).Select
Else
 Application.EnableEvents = False
 Cells(ligne + 1, 4).FormulaR1C1 = "TVA"
 Cells(ligne + 1, 5).FormulaR1C1 = "=ROUND(R[-1]C[1]/1.055*0.055,2)"
 Cells(ligne + 2, 4).FormulaR1C1 = "SANDWICH"
 Cells(ligne + 2, 5).FormulaR1C1 = "=R[-2]C[1]-R[-1]C"
 Application.EnableEvents = True
 Cells(ligne + 3, 1).Select
End If

Si vous avez une meilleure solution à me proposer je suis également preneur. Je ne demande qu'à pouvoir m'améliorer.

Je vous remercie d'avance pour votre aide.

Naunaud59

Bonjour,

Non seulement les écritures entre Daunat et Miko sont très proches, mais également celles selon la valeur de Cells(ligne, 12).
Moyennant l'utilisation de variables supplémentaires tu peux réduire ces 4 écritures en une seule :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Dim ligne As Long, offsetCol As Long, cat As String If Not Application.Intersect(Target, Range("E2:F1500")) Is Nothing Then ligne = Target.Row If Cells(ligne, 12) < 0 Then offsetCol = 1 Select Case Cells(ligne, 4) Case "DAUNAT": cat = "SANDWICH" Case "MIKO": cat = "ICE CREAM" End Select ' écriture Application.EnableEvents = False Cells(ligne + 1, 4).FormulaR1C1 = "TVA" Cells(ligne + 1, 5 + offsetCol).FormulaR1C1 = "=ROUND(R[-1]C[1]/1.055*0.055,2)" Cells(ligne + 2, 4).FormulaR1C1 = cat Cells(ligne + 2, 5 + offsetCol).FormulaR1C1 = "=R[-2]C[1]-R[-1]C" Application.EnableEvents = True Cells(ligne + 3, 1).Select End If
Sans tester, j'espère que de petites erreurs ne s'y sont pas glissées...
Déjà note que j'ai passé Dim ligne en As Long. As Integer un peu juste, il ne permet pas d'adresser toutes les lignes.
Ensuite la partie :
Code:

1 2 3 4 Select Case Cells(ligne, 4) Case "DAUNAT": cat = "SANDWICH" Case "MIKO": cat = "ICE CREAM" End Select
peut être écrite en dur comme ici de plusieurs façons.
Mais le mieux dans ce cas est d'écrire une table de correspondance dans une feuille paramètre, le code la récupérant.
Ainsi en cas de modification ou d'extension tu n'as que cette table à reprendre, le code réalisé devant prendre en compte cette éventualité (+/- de lignes, changements des libellés) et n'étant pas à reprendre.

eric

Bonjour Eric,

Merci pour ton aide, tu m'as enlevé une grosse épine du pied !

J'ai repris ton code en le modifiant quelque peu pour qu'il fonctionne :
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 Private Sub Worksheet_Change(ByVal Target As Range) Dim ligne As Long, cat As String If Not Application.Intersect(Target, Range("E2:F1500")) Is Nothing Then ligne = Target.Row Select Case Cells(ligne, 4) Case "DAUNAT": cat = "SANDWICH" Case "MIKO": cat = "ICE CREAM" End Select If Cells(ligne, 12) < 0 Then Application.EnableEvents = False Cells(ligne + 1, 4).FormulaR1C1 = "TVA" Cells(ligne + 1, 6).FormulaR1C1 = "=ROUND(R[-1]C[-1]/1.055*0.055,2)" Cells(ligne + 2, 4).FormulaR1C1 = cat Cells(ligne + 2, 6).FormulaR1C1 = "=R[-2]C[-1]-R[-1]C" Application.EnableEvents = True Cells(ligne + 3, 1).Select Else Application.EnableEvents = False Cells(ligne + 1, 4).FormulaR1C1 = "TVA" Cells(ligne + 1, 5).FormulaR1C1 = "=ROUND(R[-1]C[1]/1.055*0.055,2)" Cells(ligne + 2, 4).FormulaR1C1 = cat Cells(ligne + 2, 5).FormulaR1C1 = "=R[-2]C[1]-R[-1]C" Application.EnableEvents = True Cells(ligne + 3, 1).Select End If End If End Sub
J'ai enlevé tout ce qui se rapportait à Offsetcol pour que ça fonctionne. J'avoue que je ne comprends pas réellement à quoi ça pouvais servir mais c'est le seul élément qui me renvoyait des bugs.

En écoutant ton idée de créer une feuille je me rends compte que ça pourrait être la meilleure solution. Il se trouve que j'ai justement la 1ère feuille qui contient toutes les données. J'ai par exemple DAUNAT et MIKO en A1 et A2, est-il possible de mettre SANDWICH et ICE CREAM en E1 et E2 et garder la structure du codage ci dessus?

Un grand merci en tout cas pour ton bon travail !

Naunaud

02/08/2017, 22h49
eriiic

Bonjour,

tes 2 groupes d'écritures sont identiques à 1 colonne près pour certaines lignes.
+offsetCol (=0 ou 1) servait à écrire en colonne 5 ou 6 selon le besoin. Je m'étais peut-être planté dans le test pour le fabriquer. Faut mettre un peu plus les mains dans le cambouis pour progresser ;-)

Citation:

J'ai par exemple DAUNAT et MIKO en A1 et A2, est-il possible de mettre SANDWICH et ICE CREAM en E1 et E2 et garder la structure du codage ci dessus?

tout est possible mais ça serait mieux si tu arrives à mettre SANDWICH en B1.
Pour lire une plage et la mettre en tableau :
Dim datas
datas=[A1:B10].value
datas est une variable tableau de 10 lignes, 2 colonnes
datas(2,2)="ICE CREAM"
Tu boucles sur la 1ère colonne pour trouver DAUNAT, même ligne colonne 2 (ou 5) tu trouves SANDWICH.
eric

Bonjour,

Les variables, boucles et moi ça fait trois. J'ai du mal à comprendre ce que je dois faire exactement. J'ai écris le code permettant de chercher la valeur dans ma colonne A mais pour le reste j'avoue que je suis complètement perdu...

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
 Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim ligne As Long, cat As String, datas As Range
 
    datas = Sheets("Test").[A1:B20].Value
 
    If Not Application.Intersect(Target, Range("E2:F1500")) Is Nothing Then
        ligne = Target.Row
 
        If datas.Find(what:=Cells(ligne, 4)).Value > 0 Then
 
 If Cells(ligne, 12) < 0 Then
 
 Application.EnableEvents = False
 Cells(ligne + 1, 4).FormulaR1C1 = "TVA"
 Cells(ligne + 1, 6).FormulaR1C1 = "=ROUND(R[-1]C[-1]/1.055*0.055,2)"
 Cells(ligne + 2, 4).FormulaR1C1 = cat
 Cells(ligne + 2, 6).FormulaR1C1 = "=R[-2]C[-1]-R[-1]C"
 Application.EnableEvents = True
 Cells(ligne + 3, 1).Select
 
Else
 
Application.EnableEvents = False
Cells(ligne + 1, 4).FormulaR1C1 = "TVA"
Cells(ligne + 1, 5).FormulaR1C1 = "=ROUND(R[-1]C[1]/1.055*0.055,2)"
Cells(ligne + 2, 4).FormulaR1C1 = cat
Cells(ligne + 2, 5).FormulaR1C1 = "=R[-2]C[1]-R[-1]C"
Application.EnableEvents = True
Cells(ligne + 3, 1).Select
 
 
End If
End If
End Sub

Je ne suis peut être pas sur la bonne voie?

Merci d'avance

Naunaud

04/08/2017, 08h46
eriiic

Bonjour,

Là tu as une grossière erreur, signalée par le compilateur en plus. Indente correctement ton code pour éviter celles de ce type.
Je ne vois pas où tu recherches le produit pour initialiser cat (?)
A la limite si tu n'en cherches qu'un à chaque fois tu peux faire un .find sur la feuille, ça ne sera pas considérablement plus long.
eric