pb avec formula et cellule variable

**fafabrice31** · 26/03/2018, 10h38

bonjour le forum,

desolé de vous embeter encore une fois, mais je seche malgré mon week-end de recherche.
j'ai un UF 'Ajout matériel'(dans le VBA 'mon_userform qui me permet de rentrer une nouvelle ligne de matériel.
tout se passe bien, même en colonne L. la formule se colle bien

Code :

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

Range("L" & lr).Formula = "=" & TextBox_val.Value & "-(AUJOURDHUI()-F" & lr & ")"

TExtbox.. est du texte ; 'lr' est une integer public qui définit la ligne
Par contre, elle ne se calcule pas. je dois venir dans mpn tableau, cliquer dans le champs et valider. la cellule "F" & lr n'est pas reconnu comme cellule.

j'ai essayé avec un .calculate derrière, en insérant des touches F2;F9;enter, mais rien y fait.
pourtant, la formule est bien écrite...

je précise que je veux une formule calculée dans ma case et non pas la formule texte, ni que le résultat, car j'utilise ensuite un filldown pour les autres insertions du même modèle.

également, si vous voyez des erreurs ou des rallonges dans le code, n’hésitez pas...

voici le code de l'UF, mon fichier est trop gros pour passer..

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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
Public feuille As Integer
Public lr As Integer
Public lastrow As Integer

Private Sub UserForm_Initialize()
feuille = Year(Date)
Sheets("" & feuille & "").Activate
FiltresNeutres
End Sub

Private Sub CommandButton1_Click() 'Bouton Fermer
Unload Me
End Sub

Private Sub ComboBox_pompe_Change()
TextBox_val.Value = ""
TextBox_val.Enabled = False
lr = VerifModele
End Sub

Function VerifModele() As Integer
With Sheets("" & feuille & "") 'dans la feuille de l'année en cours
    lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
    Set modele_existe = .Range("B7:B" & lastrow).Find(Me.ComboBox_pompe.Value, lookat:=xlWhole) 'on regarde déjà si le numéro existe dans la feuille
    If modele_existe Is Nothing Then
        TextBox_val.Enabled = True
        VerifModele = lastrow + 1
    Else: TextBox_val.Value = "Ne pas saisir"
    VerifModele = modele_existe.Row
    End If
End With
End Function

Private Sub CommandButton2_Click() 'bouton Ajouter
Application.ScreenUpdating = False
Dim modele As String
Dim no_ligne As Long
Dim fl As Worksheet

For i = 1 To 5 'on commence par passer tous les labels en Noir par défaut
    Me.Controls("Label" & i).ForeColor = RGB(0, 0, 0)
Next i

'on vérifie d'abord que toutes les infos sont saisies: Si manquante: on passe le label en Rouge
If ComboBox_pompe.Value = "" Then
    Label1.ForeColor = RGB(255, 0, 0)
    ManqueInfo = "Modèle de pompe"
End If
If TextBox_serie.Value = "" Then
    Label2.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "N° Série"
End If
If TextBox_MES.Value = "" Then
    Label3.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "Date de MES"
End If
If TextBox_etalonnage.Value = "" Then
    Label4.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "Dernier étalonnage"
End If
If TextBox_kalilab.Value = "" Then
    Label5.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "Kalilab"
End If

If ManqueInfo <> "" Then 's'il manque quelque chose.. on l'indique et on quitte la macro
    MsgBox "Manque les infos suivantes:" & Chr(10) & ManqueInfo
    Exit Sub
End If

'AVANT de copier, on regarde s'il existe déjà dans une des feuilles le n° Kalilab OU le numéro de Série
For Each fl In Worksheets           'pour chaque feuille
    If IsNumeric(fl.Name) Then      'si le nom est numerique
    If fl.Name >= Year(Date) Then   'si le numero est sup/egal à l'année en cours
        With fl
    
'*************************insertion d'1 nouvelle ligne en reprenant les formules existantes****************************
            .Rows(lr).Copy 'on copie la dernière ligne
            .Rows(lr).Insert shift:=xlDown 'on ABAISSE la dernière ligne pour insérer la copie --> les formules qui utilisent la dernière ligne se mettent donc à jour
            Application.CutCopyMode = False

            .Rows(lr).ClearContents 'on efface la dernière ligne pour permettre de coller les nouvelles données
            .Rows(lr).ClearComments
            .Rows(lr).Interior.ColorIndex = 2
            
            .Range("A" & lr) = TextBox_kalilab.Value 'on rentre les valeurs
            .Range("B" & lr) = ComboBox_pompe.Value
            .Range("C" & lr) = TextBox_serie.Value
            .Range("D" & lr) = CDate(TextBox_MES.Value)
            .Range("F" & lr) = CDate(TextBox_etalonnage.Value)
            .Range("N" & lr) = ComboBox_prop.Value
            
            
            If TextBox_val.Enabled = True Then
            'Range("L" & lr).Select
            
' /*/*/*/*/*/*//*/*/*/*/*/ ICI */*/*/*/*/*/*/*/
            Range("L" & lr).Formula = "=" & TextBox_val.Value & "-(AUJOURDHUI()-(F" & lr & "))"
            
            'Application.Calculate
            
            'SendKeys "{F2}"
            'SendKeys "{F9}"
            'SendKeys "{ENTER}"
            'Selection.NumberFormat = "General"
            Else: .Range("L" & lr).Resize(2).FillUp
            
            End If
                        
            If .Range("B" & lr).Comment Is Nothing And Not IsNumeric(.Range("B" & lr)) Then         'si il n'y pas de commentaire
                .Range("B" & lr).AddComment                                                               'on en met 1
                Msg = "N° serie: " & .Range("C" & lr) & Chr(10) & "Date MES: " & .Range("D" & lr) & Chr(10) & "Date étalonnage: " & Chr(10) & .Range("F" & lr)
                .Range("B" & lr).Comment.Text Text:=Msg
                .Range("B" & lr).Comment.Shape.TextFrame.AutoSize = True
            End If
            
        End With
    End If
    End If
Next fl

'********************* on vide le formulaire *******************
ComboBox_pompe.Value = ""
TextBox_serie.Value = ""
TextBox_MES.Value = ""
TextBox_etalonnage.Value = ""
TextBox_kalilab.Value = ""
TextBox_val.Value = ""
ComboBox_prop.Value = ""

'UserFiltres
Application.ScreenUpdating = True
End Sub


Private Sub TextBox_serie_AfterUpdate()
With Sheets("" & feuille & "")
Set TrouveNumS = .Range("C8:C" & lastrow).Find(TextBox_serie.Value, lookat:=xlWhole)    'recherche n° Serie
If Not TrouveNumS Is Nothing Then                                               'si n° serie trouvé
        MsgBox "N° série deja existant", vbExclamation + vbOKOnly, "alerte"        'message
        Exit Sub                                                                   ' on sort
End If
End With
End Sub

Private Sub TextBox_kalilab_AfterUpdate()
With Sheets("" & feuille & "")
Set TrouveKal = .Range("A8:A" & lastrow).Find(TextBox_kalilab.Value, lookat:=xlWhole) 'recherche n° Kalilab
If Not TrouveKal Is Nothing Then                                                'si n°kalilab trouvé
    MsgBox "N° KALILAB deja existant", vbExclamation + vbOKOnly, "alerte"       'message
    Exit Sub                                                                    'on sort
End If
End With
End Sub
Private Sub TextBox_val_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Interdire les lettres
     If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub TextBox_MES_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Interdire les lettres
     If InStr("0123456789/", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub
Private Sub TextBox_etalonnage_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Interdire les lettres
     If InStr("0123456789/", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub TextBox_MES_Change() 'pour controler la saisie d'une date au format dd/mm/yyyy
Dim valeur As Byte
valeur = Len(TextBox_MES)
    If valeur = 2 Or valeur = 5 Then
    TextBox_MES = TextBox_MES & "/"   'afficher "/" aprés la saisie des 2 premiers chiffres
    End If 'ajouter test pour vérifier la validité de la date saisie !
If valeur = 10 Then
    If ((Split(TextBox_MES, "/")(0) > 31) Or (Split(TextBox_MES, "/")(1) > 12) Or (Split(TextBox_MES, "/")(2) < 1900)) Then
        TextBox_MES = ""
        MsgBox "La date est fausse", vbOKOnly, "MES"
        Exit Sub
    End If
End If
End Sub
Private Sub TextBox_etalonnage_Change() 'pour controler la saisie d'une date au format dd/mm/yyyy
Dim valeur As Byte
valeur = Len(TextBox_etalonnage)
If valeur = 2 Or valeur = 5 Then
TextBox_etalonnage = TextBox_etalonnage & "/"   'afficher "/" aprés la saisie des 2 premiers chiffres
End If
'ajouter test pour vérifier la validité de la date saisie !
If valeur = 10 Then
    If ((Split(TextBox_etalonnage, "/")(0) > 31) Or (Split(TextBox_etalonnage, "/")(1) > 12) Or (Split(TextBox_etalonnage, "/")(2) < 1900)) Then
    TextBox_etalonnage = ""
    MsgBox "La date est fausse", vbOKOnly, "etalonnage"
    End If
End If
End Sub

Private Sub ComboBox_prop_Change()              'on force la majuscule
ComboBox_prop.Text = UCase(ComboBox_prop.Text)
End Sub

Private Sub TextBox_serie_Change()              'on force la majuscule
TextBox_serie.Text = UCase(TextBox_serie.Text)
End Sub
Private Sub TextBox_kalilab_Change()            'on force la majuscule
TextBox_kalilab.Text = UCase(TextBox_kalilab.Text)
End Sub
Private Sub TextBox_MES_Exit(ByVal Cancel As MSForms.ReturnBoolean)     'controle du format de date
If Len(TextBox_MES) <> 0 And Len(TextBox_MES) <> 10 Then
MsgBox "date au format jj/mm/aaaa", vbInformation + vbOKOnly, "etalonnage"
TextBox_MES = ""
Cancel = True
End If
End Sub
Private Sub TextBox_etalonnage_Exit(ByVal Cancel As MSForms.ReturnBoolean)  'controle du format de date
If Len(TextBox_etalonnage) <> 0 And Len(TextBox_etalonnage) <> 10 Then
MsgBox "date au format jj/mm/aaaa", vbInformation + vbOKOnly, "etalonnage"
TextBox_etalonnage = ""
Cancel = True
End If
End Sub
Sub compile_comment() 'permet d'ajouter un commenaire sur toutes les cellules de la colonne B avec N° serie / Date de MES / date d'etalonnage
With ActiveSheet
    fin = .Range("B" & .Rows.Count).End(xlUp).Row   'on trouve la derniere ligne
    For i = 8 To fin
        If .Range("B" & i).Comment Is Nothing And Not IsEmpty(.Range("B" & i)) Then
            .Range("B" & i).AddComment
            Msg = "N° serie: " & .Range("C" & i) & Chr(10) & "Date MES: " & .Range("D" & i) & Chr(10) & "Date étalonnage: " & .Range("E" & i)
            .Range("B" & i).Comment.Text Text:=Msg
            .Range("B" & i).Comment.Shape.TextFrame.AutoSize = True
        End If
    Next i
End With
End Sub

voici le fichier complet:
https://www.grosfichiers.com/DPGZeVUVJn07V

en vous remerciant

**Menhir** · 26/03/2018, 11h07

Envoyé par fafabrice31

Par contre, elle ne se calcule pas. je dois venir dans mpn tableau, cliquer dans le champs et valider. la cellule "F" & lr n'est pas reconnu comme cellule.

C'est parce que tu as utilisé une fonction en français.
Pour VBA, par défaut, c'est l'anglais.
Si tu veux utiliser des fonction dans la langue définit pour Excel (le français dans ton cas), tu peux le faire avec la propriété FormulaLocal à la place de Formula.

**fafabrice31** · 26/03/2018, 11h11

ouah!
comment j'ai fais pour ne pas trouver ca!

merci bcp.

pb avec formula et cellule variable [XL-2013]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager