Discussion :

[benadry]

Bonjour,


J'ai un tableau Excel qui récupère des données d'une Base Agents en fonction du nom de l'agent (menu déroulant).

J'ai aussi des cellules dans lesquelles la valeur peut être calculée automatiquement ou non, en fonction des critères.

Le problème est que si l'utilisateur est amené à entrer manuellement une valeur, la formule contenue dans la cellule est écrasée.

J'ai déjà une macro qui efface le contenu de certaines cellules quand le nom de l'agent change.
Je cherche à compléter cette macro pour que, dans les cases où la saisie est manuelle ou automatique, la formule contenue dans la cellule soit recopiée à chaque fois que le nom de l'agent est modifié.

En résumé, ça donne ceci :
Si la valeur de B5 change, cela efface B11, B24, B28 ...

Parallèlement, je souhaiterais que la formule contenue en B28 (pour l'exemple, je l'ai simplifiée, mais en fait elle fait plus de 10 lignes) soit recopiée en B28. Je pense qu'il faut déjà inclure la formule dans la macro ; car, comme je l'ai dit, si l'utilisateur tape une valeur lui-même en B28 et que la macro recopie B28, cela ne sert à rien.

J'ai essayé plusieurs codes, repris dans le fichier VB, mais cela ne fonctionne pas.
Si quelqu'un pouvait donc m'aider.

Merci d'avance.

Cordialement.

[nibledispo]

Bonjour,

Pourquoi dans l'exemple effacer B28 pour la recopier ensuite ?

De plus, ne serait-il pas plus simple d'interdire la saisie manuelle en protégeant la cellule contenant la formule.

Sinon si tu tiens vraiment à recopier alors utilise formula = " =(formule)
Pour mémoire, tu peux utiliser l'enregistreur de macro qui te fabriquera la formule.
pour cela, tu te positionnes sur la cellule qui doit recevoir la formule et tu frappe toutes les éléments entrant dans cette dernière.

Cordialement.

[benadry]

Bonjour le forum,

Merci à Nibledispo pour ta réponse.

Le problème est que je ne peux pas interdire la saisie manuelle puisqu'elle est justement possible alternativement avec l'utilisation de la formule.

Pour l'enregistrement de la macro, j'ai bien essayé, mais ça ne fonctionne pas !

Si quelqu'un a une autre idée ...


Merci d'avance.

Cordialement.

[nibledispo]

Bonjour,

Quelle est la formule d'une dizaine de lignes car dans la case B28 il n'y présentement que AA.

De plus? tu évoque un fichier VB et tu joins Test1. n'as tu pas oublié de joindre quelque chose ?

En effet, je ne vois dans test1 aucun endroit contenant les retenues habituelles sur un salaire (retraite, maladie, .......).

Cordialement,

[benadry]

Rebonjour,

Le fichier que j'ai envoyé est un fichier de test. Il ne reprend donc pas la plupart des formules que j'ai écrites, ni les retenues sur salaire.

En revanche, dans mon vrai fichier, tout est bien présent. Mais, celui-ci est trop lourd et prendrait beaucoup trop de temps à anonymiser, d'où le fichier test, certes réduit, mais qui reprend l'essentiel.

Je ne peux pas joindre le fichier contenant la macro, puisqu'apparemment le forum n'accepte pas les fichiers .xlsm.

Le voici cependant :

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
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim I As Integer
 
 
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("b5"), Target) Is Nothing Then
      Application.EnableEvents = False
 
        Range("b11").ClearContents
        Range("b24").ClearContents
        Range("b28").ClearContents
        Range("b29").ClearContents
        Range("c29").ClearContents
        Range("b30").ClearContents
        Range("c30").ClearContents
        ' [...]
      Application.EnableEvents = True
    End If
 
If Target.Address = "$B$28" Then
Copy.Range("$B$28").FormulaLocal = "XXXXXX" 'Ici on recopie la formule
 
End If
 
End Sub

Or, si les cellules s'effacent bien quand la valeur entrée en B5 varie, la valeur de la cellule B28 ne se recopie pas !

Merci d'avance.

Cordialement.

[jordane45]

Bonsoir,

Surement comme ça :

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
 
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("b5"), Target) Is Nothing Then
    '-------------------------------------
    'Au passage j'aurai utilisé :
    'if target.Address = "$B$5" then
    ' Ce qui revient au même...
    '----------------------------------------
      Application.EnableEvents = False
        Range("b11").ClearContents
        Range("b24").ClearContents
        Range("b28").ClearContents
        Range("b29").ClearContents
        Range("c29").ClearContents
        Range("b30").ClearContents
        Range("c30").ClearContents
        ' [...]
 
        'Recopie de la formule dans B28
        Range("B28").Formula = "=IF(""A1""<>2,""ok"",""ko"")"
      Application.EnableEvents = True
    End If

Quoi qu'il en soit, votre ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Copy.Range("$B$28").FormulaLocal = "XXXXXX" 'Ici on recopie la formule

Doit vous faire une erreur...

Copy.range ? ça n'existe pas il me semble...
A la rigueur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("$B$28").FormulaLocal = "XXXXXX" 'Ici on recopie la formule

Pensez également à placer vos Application.EnableEvents = False dès le début du code et le Application.EnableEvents = True juste avant le End Sub..
Sinon, votre programme va boucler sans fin, vu qu'il se déclenche à la modification de la feuille..et que vous modifiez la feuille justement;.

[benadry]

Bonsoir Jordane45,

Merci beaucoup pour le coup de main.

Malheureusement, quand j'exécute la macro, Excel plante.

Il me renvoie des erreurs diverses : "espace pile insuffisant" ou, plus souvent "la méthode formula de l'objet Range a échoué".

Avez-vous une idée ?

Merci d'avance.

Re-,

Autre problème : je n'arrive pas à substituer ma formule Excel à votre exemple dans

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("B28").Formula = "=IF(""A1""<>2,""ok"",""ko"")"

Ma formule est très très longue ! La voici ci-dessous (anonymisée, car à la place des AAA..., il y a des informations) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=IF(B29="",,IF(OR(B29="AAA",B29="AAB",B29="AAC",B29="AAD"),('BS POUR CONTROLE'!G69+'BS POUR CONTROLE'!G75+'BS POUR CONTROLE'!G80)*$H$48,IF(B29="AAE",1/30*('BS POUR CONTROLE'!G69+IF(OR(B31="Prime1",B31="Prime2",B31="Prime3"),C31)+IF(OR(B32="Prime1",B32="Prime2",B32="Prime3"),C32)+IF(OR(D30="Prime1",D30="Prime2",D30="Prime2"),E30)+IF(OR(D31="Prime1",D31="Prime2",D31="Prime3 "),E31)),IF(B29="AAF",1/50*('BS POUR CONTROLE'!G69+IF(OR(B31="Prime1",B31="Prime2",B31="Prime3"),C31)+IF(OR(B32="Prime1",B32="Prime2",B32="Prime3"),C32)+IF(OR(D30="Prime1",D30="Prime2",D30="Prime2"),E30)+IF(OR(D31="Prime1",D31="Prime2",D31="Prime3 "),E31)),IF(B29="AAG",1/160*('BS POUR CONTROLE'!G69+ IF(OR(B32="Prime1",B32="Prime2",B32="Prime3"),C32)+IF(OR(D30="Prime1",D30="Prime2",D30="Prime2"),E30)+IF(OR(D31="Prime1",D31="Prime2",D31="Prime3 "),E31)),IF(OR(B29="AAH",B29="AAI",B29="AAJ",B29="AAK",B29="AAL",B29="AAM"),0*$H$48,IF(OR(B29="AAN",B29="AAO",B29="AAN",B29="AAQ"),('BS POUR CONTROLE'!G69/2)*$H$48)))))))

La formule est pourtant bien au format VBA. Mais impossible de l'insérer : quand j'essaie de la mettre entre les guillemets de formula, elle devient rouge et pas moyen !

Là encore, je suis preneur de toute suggestion !

Merdci d'avance.

Cordialement.

[parmi]

Bonjour,

Dans ta formule, tu dois doubler les apostrophes lorsqu'il y en a.

Donc,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=IF(B29="",,IF(OR(B29="AAA",B29="AAB",

devient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=IF(B29="""",,IF(OR(B29=""AAA"",B29=""AAB"",

si, bien sûr, AAA est du texte normalement entouré d'apostrophe

[benadry]

Bonjour le forum,

Merci pour ton conseil, Parmi.

Effectivement, en rajoutant les doubles guillemets, ça va déjà mieux.

Cependant, j'ai un autre problème : la formule faisant plusieurs lignes, la macro "vire au rouge" dès que j'atteins la fin de la première ligne. Comment puis-je faire ?

Sans doute avec un & vbcr, mais je ne sais pas exactement comment procéder.

Merci d'avance.

Cordialement.

[benadry]

Je pense avoir trouvé pour aller à la ligne :

Quand je tape :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

[fin du code]" & vbCr & ""

Je n'ai plus d'erreur.

En revanche, comment fait-on pour entamer la ligne suivante ?

[benadry]

Rebonjour,

Sur ce post http://www.developpez.net/forums/d10...ormule-resolu/, j'ai trouvé une solution :

En indiquant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim Frm As String
'[...]
Frm = "[Mon Code]"
Frm = Frm & "[Suite de mon Code]"

Cela fonctionne.

En revanche, quand je lui mets, comme dans le post cité ci-dessus :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("B28").Formula = Frm

j'obtiens une erreur d'exécution 1004.

Quelqu'un pourrait-il m'expliquer ?

Merci d'avance.

[parmi]

Ça dépend possiblement de la façon dont tu "remplis" Frm
Il faudrait voir cette partie pour pouvoir répondre

[benadry]

Bonsoir Parmi,
Bonsoir le forum,

Voici le code en question :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Frm = "=IF(B29="""",,IF(OR(B29=""AAA"",B29=""AAB"",B29=""AAC"",B29=""AAD""),('BS POUR CONTROLE'!G69+'BS POUR CONTROLE'!G75+'BS POUR CONTROLE'!G80)*$H$48,IF(B29=""AAE"",1/30*('BS POUR CONTROLE'!G69+IF(OR(B31=""Prime1"",B31=""Prime2"",B31=""Prime3""),C31)+IF(OR(B32=""Prime1"",B32=""Prime2"",B32=""Prime3""),C32)+IF(OR(D30=""Prime1"",D30=""Prime2"",D30=""Prime3""),E30)+IF(OR(D31=""Prime1"",D31=""Prime2"",D31=""Prime3""),E31)),IF(B29=""AAF"",1/160*('BS POUR CONTROLE'!G69+IF(OR(B31=""Prime1"",B31=""Prime2"",B31=""Prime3""),C31)"
Frm = Frm & "+IF(OR(B32=""Prime1"",B32=""Prime2"",B32=""Prime3""),C32)+IF(OR(D30=""Prime1"",D30=""Prime2"",D30=""Prime3""),E30)+IF(OR(D31=""Prime1"",D31=""Prime2"",D31=""Prime3""),E31)),IF(OR(B29=""AAG"",B29=""AAH"",B29=""AAI"",B29=""AAJ"",B29=""AAK"",B29=""AAL""),0*$H$48,IF(OR(B29=""AAM"",B29=""AAN"",B29=""AA0"",B29=""AAP""),('BS POUR CONTROLE'!G69/2)*$H$48)))))))"
Range("$C$29").Formula = Frm

Je l'ai anonymisé, comme hier.

Je précise que la formule fonctionne très bien sous Excel.

Le problème est donc, à mon avis, une question de syntaxe VBA. En effet, la formule elle-même, copiée en VBA, ne fait pas apparaître d'erreur.
Apparemment, le Frm est également reconnu, puisque quand je passe sur le code, il me met bien à quoi correspond ce Frm.

Merci de ton aide. Là, je patauge complètement.

[parmi]

Tu n'étais pas loin...
Une parenthèse de trop à la fin

[benadry]

Bonjour Parmi,
Bonjour le forum,

Malheureusement, ça ne marche pas !

J'ai retourné le problème dans tous les sens depuis hier et rien !

Je pense donc avoir trouvé une solution de contournement. Au lieu de faire une macro pour copier la formule, je peux aller la mettre dans une autre feuille et la copier dans ma case.
J'ai utilisé l'enregistreur de macro et la recopie se fait bien.

En revanche, quand je copie mon code de recopie en dessous du code préexistant (d'effacement des données), ça bug : j'ai toujours le message "la méthode Select de la classe Range a échoué" au niveau de Range("A33").Select. Je précise aussi que la phase d'effacement des données (première partie de la macro) et d'alimentation automatique de B31 en fonction de B15 marche très bien.

Voici mon code. Quelqu'un pourrait-il y regarder ? Je ne suis pas du tout spécialiste des macros et je ne vois vraiment pas que faire !

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim I As Integer
  Dim Frm As String
 
      If Target.Address = "$B$6" Then
        Application.EnableEvents = False
        Range("b12").ClearContents
        Range("b25").ClearContents
        Range("b29").ClearContents
        Range("c29").ClearContents
        Range("b31").ClearContents
        Range("b31").ClearContents
        Range("b32").ClearContents
        Range("c32").ClearContents
        Range("d29").ClearContents
        Range("d31").ClearContents
        Range("e31").ClearContents
        Range("b34").ClearContents
        Range("c34").ClearContents
        Range("d34").ClearContents
        Range("e34").ClearContents
        Range("b35").ClearContents
        Range("c35").ClearContents
        Range("d35").ClearContents
        Range("e35").ClearContents
        Range("b36").ClearContents
        Range("c36").ClearContents
        Range("d36").ClearContents
        Range("e36").ClearContents
        Range("C45").ClearContents
        Range("C46").ClearContents
        Range("C47").ClearContents
        Range("C48").ClearContents
        Range("E45").ClearContents
        Range("E46").ClearContents
        Range("E47").ClearContents
        Range("E48").ClearContents
        Range("C50").ClearContents
        Range("C51").ClearContents
        Range("C52").ClearContents
        Range("C53").ClearContents
        Range("E50").ClearContents
        Range("E51").ClearContents
        Range("E52").ClearContents
        Range("E53").ClearContents
        Range("C55").ClearContents
        Range("C56").ClearContents
        Range("C57").ClearContents
        Range("C58").ClearContents
        Range("E55").ClearContents
        Range("E56").ClearContents
        Range("E57").ClearContents
        Range("E58").ClearContents
        Range("C60").ClearContents
        Range("C61").ClearContents
        Range("C62").ClearContents
        Range("C63").ClearContents
        Range("E60").ClearContents
        Range("E61").ClearContents
        Range("E62").ClearContents
        Range("E63").ClearContents
      Application.EnableEvents = True
    End If
 
 
       If Target.Address = "$B$6" And Target.Count = 1 And [B15] = "OPERATEUR" Then
        [B31] = "Prime1"
    End If
    If Target.Address = "$B$6" And Target.Count = 1 And [B6] = "ZEZE ROBERT" Then
        [B31] = "Prime1"
    End If
    If Target.Address = "$B$6" And Target.Count = 1 And [B15] = "SECRETAIRE" Then
        [B31] = "Prime2"
    End If
    If Target.Address = "$B$6" And Target.Count = 1 And [B15] = "CADRE" Then
        [B31] = "Prime3"
    End If
    If Target.Address = "$B$6" And Target.Count = 1 And [B15] = "COMPTABLE" Then
        [B31] = "Prime4"
    End If
 
    If Target.Address = "$B$6" Then
 
    Sheets("Autres données").Select
    Range("A33").Select
    Selection.Copy
    Sheets("Infos à renseigner").Select
    Range("C29").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
End If
 
End Sub

Merci d'avance.

Cordialement.

[benadry]

Eureka !

En cherchant sur d'autres posts, j'ai trouvé ceci :

En remplaçant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Sheets("Autres données").Select
    Range("A33").Select

Par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    Sheets("Autres données").Select
    Sheets("Autres données").Range("A33").Select

ça fonctionne parfaitement !

Il suffit de le savoir.

Merci encore pour votre aide.

Cordialement.