Compréhension If et IsEmpty

**joel50** · 06/11/2014, 15h50

Bonjour
Je ne parviens pas à faire fonctionner et à comprendre pour quoi ça ne marche pas.
Je souhaite mettre une condition afin d'éviter les erreur de diviser par zéro ou vide, j'ai entré le code suivant

Code :

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

1
2
3
4
5
 
If (Nomtextbox2) = 0 Or IsEmpty(Nomextbox2) Then
    .Cells(Ligne, 19) = 0
Else: .Cells(1, 19) = TrouveType(Nomtextbox1) / 365 / (Nomtextbox2)
End If

Qui dans mon esprit veut dire: si la toxbox2 est vide ou = zéro, écrire zéro dans la colonne 19, sinon faire l'opération testbox1/365/texbox2.

Si je met 0 dans le textbox (Nomtextbox2), le condition fonctionne, si je la laisse vive j'ai Erreur d’exécution '13' Incompatibilité de type

J’aimerai comprendre pourquoi ça bloque.

Merci
Joël

**Kimy_Ire** · 06/11/2014, 16h22

Bonjour joel50,

(Fatigué aujourd'hui... je retape mon message pour la troisième fois ! )

Bref, déclares-tu ta variables en amont de ton projet ?
J'attends ton retour pour plus de visibilité sur la manière dont tu initialises tes variables et surtout à quoi ces dernières correspondent.

Cordialement,
Kimy

**joel50** · 06/11/2014, 16h31

Vrai néophyte
?? Pas compris
Ça ne me satisfait que peux, je forcé une valeur zéro en début de code et supprimer la partie de test IsEmpty ^pour faire fonctionner.

Joël

**Jean-Philippe André** · 06/11/2014, 16h45

Salut,

la notion d'Empty est directement lié à l'attribution d'une valeur à une variable.

Si tu veux tester si une valeur de textbox, regarde du côte de IsNull().

**Kimy_Ire** · 06/11/2014, 16h48

joel50,

Ta variable Nomtextbox2 est déclarée en amont du code que tu proposes, n'est-ce pas ?

Comment ouvres-tu ton UserForm / ton formulaire pour que ta variable soit renseignée ou pas ?

As-tu la possibilité de poster l'ensemble de ton code ?

Cordialement,
Kimy

**Kimy_Ire** · 06/11/2014, 16h54

Bonjour jpcheck,

Question cependant à laquelle je n'arrive pas à répondre :
1) J'ouvre un UserForm (une Textbox + un CommandButton) sans seté ma variable Textbox et celle-ci n'est jamais Empty :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub CommandButton1_Click()
 
If IsEmpty(TextBox1) Then
    MsgBox "var_vide est vide"
Else
    MsgBox "var_vide non vide : " & TextBox1 & "."
End If
 
UserForm2.Hide
 
End Sub

2) Que je définisse ou non ma variable en début de macro permet tout de même au test IsEmpty de passer :

Code :

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

1
2
3
4
5
6
7
8
9
Sub test_joel50()
'Dim var_vide
 
If IsEmpty(var_vide) Then
    MsgBox "var_vide est vide"
End If
 
 
End Sub

=> Comment peut-on avoir une incompatibilité de type ? C'est lié au premier premier test de la condition, n'est-ce pas : (Nomtextbox2) = 0 ?

@joel50 : déclares-tu ta variable en début de macro : Dim Nomtextbox2 ?

Cordialement,
Kimy

**joel50** · 06/11/2014, 17h03

Bonjour Merci des éclaircissements.

Ci dessous mon code complet, j’allais le poster dans un prochain message mais je souhaitais arriver à la faire fonctionner entièrement avant.
Je n'avais jamais toucher au VBA avant quelques semaines, alors pour moi, dur dur.
J'ai un mal fou avec les variables, je ne parle pas de option explicite, j'ai abandonner.
J'ai construit mon code avec l'aide de contributeur de ce forum, personne de compétent n'a eu à traiter l'ensemble du code, il s'agit d’empilage de ce que j'ai compris et glaner ça et là sur les forums, et d'aides de contributeur.

J'allais le poster une fois terminé, pour une autre raison, mais peut être lié à ce même problème de variable.
Je le développe sur mon PC fixe, un I3 avec 4 Go de RAM, le code s’exécute en 2 secondes , par contre j'ai besoin de l'utiliser sur un ASUS TF 810 C (Atom Z2760 , 2 Go), il met 6/7 secondes à faire son tour et j'ai l'impression qu'il va tuer mon portable.

Il y a aussi certainement des choses à "comprimer" , les boucles, pas encore pour moi, s'il y en a c'est qu'on me la a soufflées. Toute les "chargement" =0 en début ne sont pas utile pour le travail par la suite, bien au contraire, mais ça m'a permis de me sortir de ma conditions If or IsEmpty

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
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
 
 
Private Sub CmdSuivantSystème_Click()
UsfNouvelleFiche.MultiPage1.Value = 1
End Sub
Private Sub CmdSuivantTroupeau_Click()
UsfNouvelleFiche.MultiPage1.Value = 2
End Sub
Private Sub CmdSuivantLait_Click()
UsfNouvelleFiche.MultiPage1.Value = 3
End Sub
Private Sub CmdSuivantCompta_Click()
UsfNouvelleFiche.MultiPage1.Value = 4
End Sub
Private Sub TxtDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'optionnel : on réaffiche dans le textbox le format de la date
TxtDate = Format(TxtDate, "dd/mm/yyyy")
End Sub
Private Sub TxtDatefincampagne_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'optionnel : on réaffiche dans le textbox le format de la date
TxtDatefincampagne = Format(TxtDatefincampagne, "dd/mm/yyyy")
End Sub
Private Sub TxtDatelaitréalisé_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'optionnel : on réaffiche dans le textbox le format de la date
TxtDatelaitréalisé = Format(TxtDatelaitréalisé, "dd/mm/yyyy")
End Sub
Private Sub TxtMoispaye_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'optionnel : on réaffiche dans le textbox le format de la date
TxtMoispaye = Format(TxtMoispaye, "dd/mm/yyyy")
End Sub
 
Private Sub UserForm_Initialize()
UsfNouvelleFiche.MultiPage1.Value = 0
TxtDate = Date
TxtCoûtFièvreLait.Value = Sheets("Data").Range("Cout_Fièvre_De_Lait")
TxtCoutVélageDif.Value = Sheets("Data").Range("Cout_Vélage_Difficile")
TxtCoutNonDélivrance.Value = Sheets("Data").Range("Cout_Non_Délivrance")
TxtCoutCetose.Value = Sheets("Data").Range("Cout_Cétose")
TxtCoutDeplcCaillette.Value = Sheets("Data").Range("Cout_Déplacement_Caillette")
TxtCoutMammites.Value = Sheets("Data").Range("Cout_Mammite")
TxtCoutBoiterie.Value = Sheets("Data").Range("Cout_Boiterie")
TxtCoutMétrites.Value = Sheets("Data").Range("Cout_Métrite")
TxtCoutCyclesPerdus.Value = Sheets("Data").Range("Cout_Cycle_Perdu")
TxtCoutReformeAntcip.Value = Sheets("Data").Range("Cout_Réforme_anticipée")
TxtCoutVachesMortes.Value = Sheets("Data").Range("Cout_Vache_Morte")
TxtCoûtVeauMort.Value = Sheets("Data").Range("Cout_Veau_Mort")
 
TxtCoutCult1 = 0
TxtRdtCult1 = 0
TxtCoutCult2 = 0
TxtRdtCult2 = 0
TxtCoutCult3 = 0
TxtRdtCult3 = 0
TxtCoutCult4 = 0
TxtRdtCult4 = 0
TxtCoutCult5 = 0
TxtRdtCult5 = 0
TxtCoutCult6 = 0
TxtRdtCult6 = 0
TxtCoutCult7 = 0
TxtRdtCult7 = 0
TxtCoutCult8 = 0
TxtRdtCult8 = 0
TxtCoutCult9 = 0
TxtRdtCult9 = 0
TxtCoutCult10 = 0
TxtRdtCult10 = 0
 
CboBouses1.Value = 0
CboBouses2.Value = 0
CboBouses3.Value = 0
CboBouses4.Value = 0
 
TxtNbFièvreLait = 0
TxtNbVélageDif = 0
TxtNbNonDélivrance = 0
TxtNbCétose = 0
TxtNbDeplcCaillette = 0
TxtNbMammittes = 0
TxtNbBoiterie = 0
TxtNbMétrites = 0
TxtNbCyclesPerdus = 0
TxtNbReformeAntcip = 0
TxtNbVachesMortes = 0
TxtNbVeauMort = 0
 
TxtLivraisonpossible = 0
TxtDatefincampagne = 0
TxtNbmoyenVLcampagne = 0
TxtLaittank = 0
TxtTraitetank = 4
TxtVltank = 0
TxtDatelaitréalisé = 0
TxtLaitréalisé = 0
TxtVlfincampagne = 0
TxtMoispaye = 0
TxtPrixlaitnet = 0
TxtTb = 38
TxtTp = 32
TxtUrée = 0
TxtCellules = 0
 
TxtAnnuitées = 0
TxtAnnuitNouv = 0
TxtFfct = 0
TxtBesoinsPrivés = 0
TxtVariPp = 0
TxtMargeSecu = 0
TxtTotalCharges = 0
TxtChargesExept = 0
TxtChargesFi = 0
TxtAmort = 0
TxtTotalPdt = 0
TxtPdtLait = 0
TxtPdtExept = 0
TxtLaitPdt = 0
TxtLaitPlus = 0
TxtPrixLaitAn = 0
 
 
 
    End Sub
 
Function TrouveType(V)
TrouveType = V
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function
If IsNumeric(Replace(TrouveType, ".", ",")) = True Then TrouveType = Replace(TrouveType, ",", "."): Exit Function
End Function
 
Private Sub CmdValiderFiche_Click()
     Dim DMonth As Integer
     Dim SrcRng As Range
     Dim SumVal  As Double, CntVal As Integer
     Dim RowN As Integer, ColN As Integer
 
Application.ScreenUpdating = False
 
    Sheets("Fiche").Range("AX11") = TrouveType(TxtDate)
 
With Sheets("Data_Système").ListObjects("Données_Système")
    If .ListRows.Count = 0 Then
        Range("Données_Système[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Système[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_système").ListObjects("Données_Système").ListRows(1)
    Else
        Set LignTablo = Range("Données_Système").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
 
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(TxtObjectifs)
    .Cells(1, 3) = TrouveType(TxtVl)
    .Cells(1, 4) = TrouveType(TxtG2)
    .Cells(1, 5) = TrouveType(TxtG12)
    .Cells(1, 6) = TrouveType(TxtG1)
    .Cells(1, 7) = TrouveType(TxtBoeufs)
    .Cells(1, 8) = TrouveType(TxtTaurillons)
    .Cells(1, 9) = TrouveType(TxtAnx1)
    .Cells(1, 10) = TrouveType(TxtAnx2)
    .Cells(1, 11) = TrouveType(CboDistrifourrage)
    .Cells(1, 12) = TrouveType(Cbodistriconcentrés)
    .Cells(1, 13) = TrouveType(CboTraite)
    .Cells(1, 14) = TrouveType(CboLaiterie)
    .Cells(1, 15) = TrouveType(CboNbPointdeau)
    .Cells(1, 16) = TrouveType(TxtPlacecornadis)
    .Cells(1, 17) = TrouveType(CboCouchage)
    .Cells(1, 18) = TrouveType(CboStabupature)
    .Cells(1, 19) = TrouveType(TxtObservations)
    .Cells(1, 20) = TrouveType(TxtSau)
    .Cells(1, 21) = TrouveType(CboCulture1)
    .Cells(1, 22) = TrouveType(TxtSurfcult1)
    .Cells(1, 23) = TrouveType(TxtCoutCult1)
    .Cells(1, 24) = TrouveType(TxtRdtCult1)
    .Cells(1, 25) = TrouveType(CboCulture2)
    .Cells(1, 26) = TrouveType(TxtSurfcult2)
    .Cells(1, 27) = TrouveType(TxtCoutCult2)
    .Cells(1, 28) = TrouveType(TxtRdtCult2)
    .Cells(1, 29) = TrouveType(CboCulture3)
    .Cells(1, 30) = TrouveType(TxtSurfcult3)
    .Cells(1, 31) = TrouveType(TxtCoutCult3)
    .Cells(1, 32) = TrouveType(TxtRdtCult3)
    .Cells(1, 33) = TrouveType(CboCulture4)
    .Cells(1, 34) = TrouveType(TxtSurfcult4)
    .Cells(1, 35) = TrouveType(TxtCoutCult4)
    .Cells(1, 36) = TrouveType(TxtRdtCult4)
    .Cells(1, 37) = TrouveType(CboCulture5)
    .Cells(1, 38) = TrouveType(TxtSurfcult5)
    .Cells(1, 39) = TrouveType(TxtCoutCult5)
    .Cells(1, 40) = TrouveType(TxtRdtCult5)
    .Cells(1, 41) = TrouveType(CboCulture6)
    .Cells(1, 42) = TrouveType(TxtSurfcult6)
    .Cells(1, 43) = TrouveType(TxtCoutCult6)
    .Cells(1, 44) = TrouveType(TxtRdtCult6)
    .Cells(1, 45) = TrouveType(CboCulture7)
    .Cells(1, 46) = TrouveType(TxtSurfcult7)
    .Cells(1, 47) = TrouveType(TxtCoutCult7)
    .Cells(1, 48) = TrouveType(TxtRdtCult7)
    .Cells(1, 49) = TrouveType(CboCulture8)
    .Cells(1, 50) = TrouveType(TxtSurfcult8)
    .Cells(1, 51) = TrouveType(TxtCoutCult8)
    .Cells(1, 52) = TrouveType(TxtRdtCult8)
    .Cells(1, 53) = TrouveType(CboCulture9)
    .Cells(1, 54) = TrouveType(TxtSurfcult9)
    .Cells(1, 55) = TrouveType(TxtCoutCult9)
    .Cells(1, 56) = TrouveType(TxtRdtCult9)
    .Cells(1, 57) = TrouveType(CboCulture10)
    .Cells(1, 58) = TrouveType(TxtSurfcult10)
    .Cells(1, 59) = TrouveType(TxtCoutCult10)
    .Cells(1, 60) = TrouveType(TxtRdtCult10)
 
If (TxtRdtCult1) <> 0 Then
    .Cells(1, 61) = TrouveType(TxtCoutCult1) / (TxtRdtCult1)
Else: .Cells(Ligne, 61) = 0
End If
 
If (TxtRdtCult2) <> 0 Then
    .Cells(1, 62) = TrouveType(TxtCoutCult2) / (TxtRdtCult2)
Else: .Cells(Ligne, 62) = 0
End If
 
    If (TxtRdtCult3) <> 0 Then
    .Cells(1, 63) = TrouveType(TxtCoutCult3) / (TxtRdtCult3)
Else: .Cells(Ligne, 63) = 0
End If
 
    If (TxtRdtCult4) <> 0 Then
    .Cells(1, 64) = TrouveType(TxtCoutCult4) / (TxtRdtCult4)
Else: .Cells(Ligne, 64) = 0
End If
 
    If (TxtRdtCult5) <> 0 Then
    .Cells(1, 65) = TrouveType(TxtCoutCult5) / (TxtRdtCult5)
Else: .Cells(Ligne, 65) = 0
End If
 
    If (TxtRdtCult6) <> 0 Then
    .Cells(1, 66) = TrouveType(TxtCoutCult6) / (TxtRdtCult6)
Else: .Cells(Ligne, 66) = 0
End If
 
    If (TxtRdtCult7) <> 0 Then
    .Cells(1, 67) = TrouveType(TxtCoutCult7) / (TxtRdtCult7)
Else: .Cells(Ligne, 67) = 0
End If
 
    If (TxtRdtCult8) <> 0 Then
    .Cells(1, 68) = TrouveType(TxtCoutCult8) / (TxtRdtCult8)
Else: .Cells(Ligne, 68) = 0
End If
 
    If (TxtRdtCult9) <> 0 Then
    .Cells(1, 69) = TrouveType(TxtCoutCult9) / (TxtRdtCult9)
Else: .Cells(Ligne, 69) = 0
End If
 
    If (TxtRdtCult10) <> 0 Then
    .Cells(1, 70) = TrouveType(TxtCoutCult10) / (TxtRdtCult10)
Else: .Cells(Ligne, 70) = 0
End If
 
End With
 
With Sheets("Data_Troupeau").ListObjects("Données_Troupeau")
    If .ListRows.Count = 0 Then
        Range("Données_Troupeau[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Troupeau[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_Troupeau").ListObjects("Données_Troupeau").ListRows(1)
    Else
        Set LignTablo = Range("Données_Troupeau").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(CboPoidsVl)
    .Cells(1, 3) = TrouveType(CboNecmoyen)
    .Cells(1, 4) = TrouveType(TxtProductionpic)
    .Cells(1, 5) = TrouveType(CboPrimipares)
    .Cells(1, 6) = TrouveType(TxtMoismoyen)
    .Cells(1, 7) = TrouveType(TxtMoisgestation)
    .Cells(1, 8) = TrouveType(TxtOblLaitVlAn)
    .Cells(1, 9) = TrouveType(CboBouses1)
    .Cells(1, 10) = TrouveType(CboBouses2)
    .Cells(1, 11) = TrouveType(CboBouses3)
    .Cells(1, 12) = TrouveType(CboBouses4)
 
    .Cells(1, 13) = TrouveType(100) - (CboBouses1) - (CboBouses2) - (CboBouses3) - (CboBouses4)
 
    .Cells(1, 14) = TrouveType(TxtBouses)
    .Cells(1, 15) = TrouveType(TxtNbFièvreLait)
    .Cells(1, 16) = TrouveType(TxtCoûtFièvreLait)
    .Cells(1, 17) = TrouveType(TxtNbVélageDif)
    .Cells(1, 18) = TrouveType(TxtCoutVélageDif)
    .Cells(1, 19) = TrouveType(TxtNbNonDélivrance)
    .Cells(1, 20) = TrouveType(TxtCoutNonDélivrance)
    .Cells(1, 21) = TrouveType(TxtNbCétose)
    .Cells(1, 22) = TrouveType(TxtCoutCetose)
    .Cells(1, 23) = TrouveType(TxtNbDeplcCaillette)
    .Cells(1, 24) = TrouveType(TxtCoutDeplcCaillette)
    .Cells(1, 25) = TrouveType(TxtNbMammittes)
    .Cells(1, 26) = TrouveType(TxtCoutMammittes)
    .Cells(1, 27) = TrouveType(TxtNbBoiterie)
    .Cells(1, 28) = TrouveType(TxtCoutBoiterie)
    .Cells(1, 29) = TrouveType(TxtNbMétrites)
    .Cells(1, 30) = TrouveType(TxtCoutMétrites)
    .Cells(1, 31) = TrouveType(TxtNbCyclesPerdus)
    .Cells(1, 32) = TrouveType(TxtCoutCyclesPerdus)
    .Cells(1, 33) = TrouveType(TxtNbReformeAntcip)
    .Cells(1, 34) = TrouveType(TxtCoutReformeAntcip)
    .Cells(1, 35) = TrouveType(TxtNbVachesMortes)
    .Cells(1, 36) = TrouveType(TxtCoutVachesMortes)
    .Cells(1, 37) = TrouveType(TxtNbVeauMort)
    .Cells(1, 38) = TrouveType(TxtCoûtVeauMort)
    .Cells(1, 39) = TrouveType(Txt1IA)
    .Cells(1, 40) = TrouveType(Txt3IA)
    .Cells(1, 41) = TrouveType(TxtIAVeau)
    .Cells(1, 42) = TrouveType(TxtIVIAF)
    .Cells(1, 43) = TrouveType(TxtIVV)
 
    .Cells(1, 45) = TrouveType(TxtNbFièvreLait) * (TxtCoûtFièvreLait)
    .Cells(1, 46) = TrouveType(TxtNbVélageDif) * (TxtCoutVélageDif)
    .Cells(1, 47) = TrouveType(TxtNbNonDélivrance) * (TxtCoutNonDélivrance)
    .Cells(1, 48) = TrouveType(TxtNbCétose) * (TxtCoutCetose)
    .Cells(1, 49) = TrouveType(TxtNbDeplcCaillette) * (TxtCoutDeplcCaillette)
    .Cells(1, 50) = TrouveType(TxtNbMammittes) * (TxtCoutMammittes)
    .Cells(1, 51) = TrouveType(TxtNbBoiterie) * (TxtCoutBoiterie)
    .Cells(1, 52) = TrouveType(TxtNbMétrites) * (TxtCoutMétrites)
    .Cells(1, 53) = TrouveType(TxtNbCyclesPerdus) * (TxtCoutCyclesPerdus)
    .Cells(1, 54) = TrouveType(TxtCoutReformeAntcip) * (TxtCoutReformeAntcip)
    .Cells(1, 55) = TrouveType(TxtNbVachesMortes) * (TxtCoutVachesMortes)
    .Cells(1, 56) = TrouveType(TxtNbVeauMort) * (TxtCoûtVeauMort)
 
    .Cells(1, 57) = TrouveType(TxtNbFièvreLait) * (TxtCoûtFièvreLait) _
                                + (TxtNbVélageDif) * (TxtCoutVélageDif) _
                                + (TxtNbNonDélivrance) * (TxtCoutNonDélivrance) _
                                + (TxtNbCétose) * (TxtCoutCetose) _
                                + (TxtNbDeplcCaillette) * (TxtCoutDeplcCaillette) _
                                + (TxtNbMammittes) * (TxtCoutMammittes) _
                                + (TxtNbBoiterie) * (TxtCoutBoiterie) _
                                + (TxtNbMétrites) * (TxtCoutMétrites) _
                                + (TxtNbCyclesPerdus) * (TxtCoutCyclesPerdus) _
                                + (TxtCoutReformeAntcip) * (TxtCoutReformeAntcip) _
                                + (TxtNbVachesMortes) * (TxtCoutVachesMortes) _
                                + (TxtNbVeauMort) * (TxtCoûtVeauMort)
 
End With
 
 
 
 
With Sheets("Data_Compta").ListObjects("Données_Compta")
    If .ListRows.Count = 0 Then
        Range("Données_Compta[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Compta[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_Compta").ListObjects("Données_Compta").ListRows(1)
    Else
        Set LignTablo = Range("Données_Compta").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(TxtAnnuitées)
    .Cells(1, 3) = TrouveType(TxtAnnuitNouv)
    .Cells(1, 4) = TrouveType(TxtFfct)
    .Cells(1, 5) = TrouveType(TxtBesoinsPrivés)
    .Cells(1, 6) = TrouveType(TxtVariPp)
    .Cells(1, 7) = TrouveType(TxtMargeSecu)
    .Cells(1, 8) = TrouveType(TxtTotalCharges)
    .Cells(1, 9) = TrouveType(TxtChargesExept)
    .Cells(1, 10) = TrouveType(TxtChargesFi)
    .Cells(1, 11) = TrouveType(TxtAmort)
    .Cells(1, 12) = TrouveType(TxtTotalPdt)
    .Cells(1, 13) = TrouveType(TxtPdtLait)
    .Cells(1, 14) = TrouveType(TxtPdtExept)
    .Cells(1, 15) = TrouveType(TxtLaitPdt)
    .Cells(1, 16) = TrouveType(TxtLaitPlus)
    .Cells(1, 17) = TrouveType(TxtPrixLaitAn)
    .Cells(1, 18) = TrouveType(TxtQtéConcVlAn)
    .Cells(1, 19) = TrouveType(TxtQtéConcVl1000l)
    .Cells(1, 20) = TrouveType(TxtMoyQtéConcentré)
    .Cells(1, 21) = TrouveType(TxtPrixConcVlAn)
    .Cells(1, 22) = TrouveType(TxtPrixConcVl1000l)
    .Cells(1, 23) = TrouveType(TxtMoyprixConcentré)
    .Cells(1, 24) = TrouveType(TxtFraisVétoVlAn)
    .Cells(1, 25) = TrouveType(TxtFraisVéto1000L)
    .Cells(1, 26) = TrouveType(TxtMoyFraisVéto1000L)
    .Cells(1, 27) = TrouveType(TxtFraisElevageVlAn)
    .Cells(1, 28) = TrouveType(TxtFraisElevage1000L)
    .Cells(1, 29) = TrouveType(TxtMoyFraisElevage1000L)
 
    .Cells(1, 30) = TrouveType((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu)
 
    .Cells(1, 31) = TrouveType(TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))
 
    .Cells(1, 32) = TrouveType((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))) _
                                + ((TxtTotalCharges) - (TxtChargesExept) - (TxtChargesFi) - (TxtAmort))
 
    .Cells(1, 33) = TrouveType(((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))) _
                                + ((TxtTotalCharges) - (TxtChargesExept) - (TxtChargesFi) - (TxtAmort))) _
                                - (TxtTotalPdt) + (TxtPdtLait) + (TxtPdtExept)
 
If (TxtLaitPdt) Or (TxtLaitPlus) <> 0 Then
    .Cells(1, 34) = ((((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))) _
                                + ((TxtTotalCharges) - (TxtChargesExept) - (TxtChargesFi) - (TxtAmort))) _
                                - (TxtTotalPdt) + (TxtPdtLait) + (TxtPdtExept)) _
                                / (((TxtLaitPdt) + (TxtLaitPlus)) * 1000)
 
    .Cells(1, 35) = TrouveType(TxtPrixLaitAn) - ((((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))) _
                                + ((TxtTotalCharges) - (TxtChargesExept) - (TxtChargesFi) - (TxtAmort))) _
                                - (TxtTotalPdt) + (TxtPdtLait) + (TxtPdtExept)) _
                                / (((TxtLaitPdt) + (TxtLaitPlus)) * 1000)
Else: .Cells(Ligne, 34) = 0
      .Cells(Ligne, 35) = 0
End If
 
End With
 
 
With Sheets("Data_Ration").ListObjects("Données_Ration")
    If .ListRows.Count = 0 Then
        Range("Données_Ration[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Ration[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_Ration").ListObjects("Données_Ration").ListRows(1)
        Else
        Set LignTablo = Range("Données_Ration").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(TxtNbRationsInit)
    .Cells(1, 3) = TrouveType(CbxTypeRationInit)
    .Cells(1, 4) = TrouveType(CbxAlt1Init)
    .Cells(1, 5) = TrouveType(TxtAlt1Init)
    .Cells(1, 6) = TrouveType(TxtCoutAlt1Init)
    .Cells(1, 7) = TrouveType(CbxAlt2Init)
    .Cells(1, 8) = TrouveType(TxtAlt2Init)
    .Cells(1, 9) = TrouveType(TxtCoutAlt2Init)
    .Cells(1, 10) = TrouveType(CbxAlt3Init)
    .Cells(1, 11) = TrouveType(TxtAlt3Init)
    .Cells(1, 12) = TrouveType(TxtCoutAlt3Init)
    .Cells(1, 13) = TrouveType(CbxAlt4Init)
    .Cells(1, 14) = TrouveType(TxtAlt4Init)
    .Cells(1, 15) = TrouveType(TxtCoutAlt4Init)
    .Cells(1, 16) = TrouveType(CbxAlt5Init)
    .Cells(1, 17) = TrouveType(TxtAlt5Init)
    .Cells(1, 18) = TrouveType(TxtCoutAlt5Init)
    .Cells(1, 19) = TrouveType(CbxAlt6Init)
    .Cells(1, 20) = TrouveType(TxtAlt6Init)
    .Cells(1, 21) = TrouveType(TxtCoutAlt6Init)
    .Cells(1, 22) = TrouveType(CbxAlt7Init)
    .Cells(1, 23) = TrouveType(TxtAlt7Init)
    .Cells(1, 24) = TrouveType(TxtCoutAlt7Init)
    .Cells(1, 25) = TrouveType(CbxAlt8Init)
    .Cells(1, 26) = TrouveType(TxtAlt8Init)
    .Cells(1, 27) = TrouveType(TxtCoutAlt8Init)
    .Cells(1, 28) = TrouveType(CbxAlt9Init)
    .Cells(1, 29) = TrouveType(TxtAlt9Init)
    .Cells(1, 30) = TrouveType(TxtCoutAlt9Init)
    .Cells(1, 31) = TrouveType(CbxAlt10Init)
    .Cells(1, 32) = TrouveType(TxtAlt10Init)
    .Cells(1, 33) = TrouveType(TxtCoutAlt10Init)
    .Cells(1, 34) = TrouveType(CbxAlt11Init)
    .Cells(1, 35) = TrouveType(TxtAlt11Init)
    .Cells(1, 36) = TrouveType(TxtCoutAlt11Init)
    .Cells(1, 37) = TrouveType(CbxAlt12Init)
    .Cells(1, 38) = TrouveType(TxtAlt12Init)
    .Cells(1, 39) = TrouveType(TxtCoutAlt12Init)
    .Cells(1, 40) = TrouveType(CbxAlt13Init)
    .Cells(1, 41) = TrouveType(TxtAlt13Init)
    .Cells(1, 42) = TrouveType(TxtCoutAlt13Init)
    .Cells(1, 43) = TrouveType(CbxAlt14Init)
    .Cells(1, 44) = TrouveType(TxtAlt14Init)
    .Cells(1, 45) = TrouveType(TxtCoutAlt14Init)
    .Cells(1, 46) = TrouveType(CbxAlt15Init)
    .Cells(1, 47) = TrouveType(TxtAlt15Init)
    .Cells(1, 48) = TrouveType(TxtCoutAlt15Init)
    .Cells(1, 49) = TrouveType(TxtQtéConcentréProduction)
    .Cells(1, 50) = TrouveType(TxtPrixKgConcentréProduction)
 
    .Cells(1, 52) = TrouveType(TxtNbRationsCor)
    .Cells(1, 53) = TrouveType(CbxTypeRationCor)
    .Cells(1, 54) = TrouveType(CbxAlt1Cor)
    .Cells(1, 55) = TrouveType(TxtAlt1Cor)
    .Cells(1, 56) = TrouveType(TxtCoutAlt1Cor)
    .Cells(1, 57) = TrouveType(CbxAlt2Cor)
    .Cells(1, 58) = TrouveType(TxtAlt2Cor)
    .Cells(1, 59) = TrouveType(TxtCoutAlt2Cor)
    .Cells(1, 60) = TrouveType(CbxAlt3Cor)
    .Cells(1, 61) = TrouveType(TxtAlt3Cor)
    .Cells(1, 62) = TrouveType(TxtCoutAlt3Cor)
    .Cells(1, 63) = TrouveType(CbxAlt4Cor)
    .Cells(1, 64) = TrouveType(TxtAlt4Cor)
    .Cells(1, 65) = TrouveType(TxtCoutAlt4Cor)
    .Cells(1, 66) = TrouveType(CbxAlt5Cor)
    .Cells(1, 67) = TrouveType(TxtAlt5Cor)
    .Cells(1, 68) = TrouveType(TxtCoutAlt5Cor)
    .Cells(1, 69) = TrouveType(CbxAlt6Cor)
    .Cells(1, 70) = TrouveType(TxtAlt6Cor)
    .Cells(1, 71) = TrouveType(TxtCoutAlt6Cor)
    .Cells(1, 72) = TrouveType(CbxAlt7Cor)
    .Cells(1, 73) = TrouveType(TxtAlt7Cor)
    .Cells(1, 74) = TrouveType(TxtCoutAlt7Cor)
    .Cells(1, 75) = TrouveType(CbxAlt8Cor)
    .Cells(1, 76) = TrouveType(TxtAlt8Cor)
    .Cells(1, 77) = TrouveType(TxtCoutAlt8Cor)
    .Cells(1, 78) = TrouveType(CbxAlt9Cor)
    .Cells(1, 79) = TrouveType(TxtAlt9Cor)
    .Cells(1, 80) = TrouveType(TxtCoutAlt9Cor)
    .Cells(1, 81) = TrouveType(CbxAlt10Cor)
    .Cells(1, 82) = TrouveType(TxtAlt10Cor)
    .Cells(1, 83) = TrouveType(TxtCoutAlt10Cor)
    .Cells(1, 84) = TrouveType(CbxAlt11Cor)
    .Cells(1, 85) = TrouveType(TxtAlt11Cor)
    .Cells(1, 86) = TrouveType(TxtCoutAlt11Cor)
    .Cells(1, 87) = TrouveType(CbxAlt12Cor)
    .Cells(1, 88) = TrouveType(TxtAlt12Cor)
    .Cells(1, 89) = TrouveType(TxtCoutAlt12Cor)
    .Cells(1, 90) = TrouveType(CbxAlt13Cor)
    .Cells(1, 91) = TrouveType(TxtAlt13Cor)
    .Cells(1, 92) = TrouveType(TxtCoutAlt13Cor)
    .Cells(1, 93) = TrouveType(CbxAlt14Cor)
    .Cells(1, 94) = TrouveType(TxtAlt14Cor)
    .Cells(1, 95) = TrouveType(TxtCoutAlt14Cor)
    .Cells(1, 96) = TrouveType(CbxAlt15Cor)
    .Cells(1, 97) = TrouveType(TxtAlt15Cor)
    .Cells(1, 98) = TrouveType(TxtCoutAlt15Cor)
 
If Sheets("Fiche").Range("Nb_Rations_Initiale") Or Sheets("Fiche").Range("Total_Ingestion_MS_Ration_Initiale") <> 0 Then
    .Cells(1, 100) = Sheets("Fiche").Range("Total_Ingestion_MS_Ration_Initiale") + Sheets("Fiche").Range("Qté_jour_conc_produc_troupeau") / Sheets("Fiche").Range("Nb_Rations_Initiale")
Else: .Cells(Ligne, 100) = 0
End If
 
End With
With Sheets("Data_lait").ListObjects("Données_Lait")
    If .ListRows.Count = 0 Then
        Range("Données_Lait[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Lait[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_lait").ListObjects("Données_Lait").ListRows(1)
    Else
        Set LignTablo = Range("Données_Lait").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(TxtLivraisonpossible)
    .Cells(1, 3) = TrouveType(TxtDatefincampagne)
    .Cells(1, 4) = TrouveType(TxtNbmoyenVLcampagne)
    .Cells(1, 5) = TrouveType(TxtLaittank)
    .Cells(1, 6) = TrouveType(TxtTraitetank)
    .Cells(1, 7) = TrouveType(TxtVltank)
    .Cells(1, 8) = TrouveType(TxtDatelaitréalisé)
    .Cells(1, 9) = TrouveType(TxtLaitréalisé)
    .Cells(1, 10) = TrouveType(TxtVlfincampagne)
    .Cells(1, 11) = TrouveType(TxtMoispaye)
    .Cells(1, 12) = TrouveType(TxtPrixlaitnet)
    .Cells(1, 13) = TrouveType(TxtTb)
    .Cells(1, 14) = TrouveType(TxtTp)
    .Cells(1, 15) = TrouveType(TxtUrée)
    .Cells(1, 16) = TrouveType(TxtCellules)
 
   'Calcul  Nb moyen Vl depuis le début de la campagne
    Set SrcRng = ThisWorkbook.Worksheets("Data_Lait").Range("A5").CurrentRegion
CntVal = 0
SumVal = 0
 
 For RowN = 2 To SrcRng.Rows.Count
 
 If IsDate(SrcRng(RowN, 1)) Then     'Peut être supprimé si c'est toujours une date
        DMonth = Month(SrcRng(RowN, 1))
        Debug.Print RowN, SrcRng(RowN, 1), DMonth
 
        If DMonth = 4 Then
            CntVal = 0
            SumVal = 0
   End If
 
        CntVal = CntVal + 1
        SumVal = SumVal + SrcRng(RowN, 7)
        SrcRng(RowN, 17) = SumVal / CntVal
 
 End If
Next RowN
 
   'calcul du lait total restant à livrer
    .Cells(1, 18) = TrouveType(TxtLivraisonpossible) - (TxtLaitréalisé)
     'calcul lait à livrer par vl par jour sur la campagne
If (TxtNbmoyenVLcampagne) <> 0 Then
    .Cells(1, 19) = TrouveType(TxtLivraisonpossible) / 365 / (TxtNbmoyenVLcampagne)
Else: .Cells(Ligne, 19) = 0
End If
 
'calcul lait livré par vl depuis début de campagne
If (TxtDatefincampagne) Or (TxtDatelaitréalisé) Or (TxtLivraisonpossible) = 0 Then
     .Cells(1, 20) = TrouveType(TxtLaitréalisé) / (365 - ((TxtDatefincampagne) - (TxtDatelaitréalisé))) / ((TxtLivraisonpossible) - (TxtLaitréalisé))
 Else: .Cells(Ligne, 20) = 0
End If
 
    'calcul lait restant à livrer par vl jusqu'à fin de campagne
If (TxtDatefincampagne) Or (TxtDatelaitréalisé) Or (TxtVlfincampagne) <> 0 Then
      .Cells(1, 21) = TrouveType((TxtLivraisonpossible) - (TxtLaitréalisé)) / ((TxtDatefincampagne) - (TxtDatelaitréalisé)) / (TxtVlfincampagne)
 Else: .Cells(Ligne, 21) = 0
End If
 
    'Calcul Pl réelle/ VL/jour
If (TxtLaittank) Or (TxtVltank) Or (TxtTraitetank) <> 0 Then
    .Cells(Ligne, 22) = 0
 Else: .Cells(1, 22) = TrouveType(TxtLaittank) / (TxtVltank) / ((TxtTraitetank) / 2)
End If
 
'Calcul lait à 70 par VL par jour
If (TxtLaittank) Or (TxtVltank) Or (TxtTraitetank) <> 0 Then
    .Cells(Ligne, 23) = 0
 Else: .Cells(1, 23) = TrouveType((TxtLaittank) / (TxtVltank) / ((TxtTraitetank) / 2)) * (TxtTb) * (TxtTp) / 70
End If
 
 'Calcul lait vendu par VL /jour
If (TxtLaittank) Or (TxtVltank) Or (TxtTraitetank) <> 0 Then
    .Cells(Ligne, 24) = 0
 Else: .Cells(1, 24) = TrouveType((TxtLaittank) / (TxtVltank) / ((TxtTraitetank) / 2)) * (TxtTb) * (TxtTp)
End If
 
  'Calcul lait vendu par VL /jour
If (TxtLaittank) Or (TxtVltank) Or (TxtTraitetank) Or (TxtPrixlaitnet) <> 0 Then
     .Cells(Ligne, 25) = 0
 Else: .Cells(1, 25) = TrouveType((TxtLaittank) / (TxtVltank) / ((TxtTraitetank) / 2)) * (TxtPrixlaitnet)
End If
 
 'Calcul cout ration / 1000 L
If (TxtLaittank) Or (TxtVltank) Or (TxtTraitetank) Or (TxtPrixlaitnet) <> 0 Then
.Cells(Ligne, 26) = 0
 Else: .Cells(1, 26) = TrouveType(Sheets("Fiche").Range("cout_ration_VL_j_Ration_Initiale") * 1000) / ((TxtLaittank) / (TxtVltank) / ((TxtTraitetank) / 2))
End If
 
End With
 
Unload Me
 
End Sub
 
Private Sub CmdAnnuler_Click()
Me.Hide
End Sub

Joël

Invité · 06/11/2014, 17h09

Bonjour,

Code :

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

1
2
3
4
5
 
If val( TrouveType(Nomtextbox1)) Then
    .Cells(Ligne, 19) = 0
Else: .Cells(1, 19) = val(TrouveType(Nomtextbox1)) / 365 / (Nomtextbox2)
End If

**joel50** · 06/11/2014, 17h09

Re Bonjour Kimmy
Non, je n'ai pas déclarer les variable Non texbox...
Il y en a pas mal, doit je déclarer une à une toute une à une?
Ou ai je une autre solution ou condition?
Merci
Joël

**Kimy_Ire** · 06/11/2014, 17h24

Nom du'diou !!!

Avec ce nombre de variables, si tu n'as pas fait une seule faute de frappe... chapeau !

Je vais tranquillement regarder ton code !

Je vais essayer de revenir vers toi rapidement.

Cordialement,
Kimy

Invité · 06/11/2014, 17h29

Désolé pour l'erreur

Code :

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

1
2
3
4
5
 
If val( TrouveType(Nomtextbox1)) =0 Then
    .Cells(Ligne, 19) = 0
Else: .Cells(1, 19) = val(TrouveType(Nomtextbox1)) / 365 / (Nomtextbox2)
End If

**joel50** · 06/11/2014, 17h38

Merci Kimy, Merci Robert

Kimy
Ben si, quelques fautes de frappe (et même plus), je les corrige quand ça bug et quand je les trouve, d'ailleurs à la vérification, à partir de la ligne 630, a force de bidouiller, j'ai du inverser la condition, je vais les refaire.

Robert, merci, je doit partir env 2 h2 h 30 , je regarde à mon retour à remettre de l'ordre.

Joël

**joel50** · 06/11/2014, 23h09

Bonsoir

Robert, j'ai modifié le code sur les dernières conditions avec tes instructions, a partir de la ligne 610, je ferais les autres ensuite mais 3 choses me m'interpelle:

Pourquoi je doit rajouté Val, alors qu'il y a quelques jours on a remplacer les conversion (Cdate et Val) par ta fonction TrouveType.

Pour que les conditions fonctionnent, je doit charger les textbox en valeur zéro, si qui m’embête lors des saisie notamment des dates et provoque quelques erreur de saisie à l'utilisation. Je n'ai pas trouver comment faire une double condition comme: if = 0 et if = "" ;0; function (comme je l'aurai fait en EXCEL)

Je croyais que avec Or, il suffisait qu'une des conditions soit ok pour que la condition se s’exécute pas, dans mon cas si je rajoute la textbox (txtTraitetank) toujours chargée à 4, le condition est validée et la formule plante si une des autre box diviseur est à zéro.

Code qui fonctionne mais ne me satisfait pas pleinement (sans parler de la durée d’exécution, je ferais un autre post)

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
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
 
 
Private Sub CmdSuivantSystème_Click()
UsfNouvelleFiche.MultiPage1.Value = 1
End Sub
Private Sub CmdSuivantTroupeau_Click()
UsfNouvelleFiche.MultiPage1.Value = 2
End Sub
Private Sub CmdSuivantLait_Click()
UsfNouvelleFiche.MultiPage1.Value = 3
End Sub
Private Sub CmdSuivantCompta_Click()
UsfNouvelleFiche.MultiPage1.Value = 4
End Sub
Private Sub TxtDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'optionnel : on réaffiche dans le textbox le format de la date
TxtDate = Format(TxtDate, "dd/mm/yyyy")
End Sub
Private Sub TxtDatefincampagne_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'optionnel : on réaffiche dans le textbox le format de la date
TxtDatefincampagne = Format(TxtDatefincampagne, "dd/mm/yyyy")
End Sub
Private Sub TxtDatelaitréalisé_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'optionnel : on réaffiche dans le textbox le format de la date
TxtDatelaitréalisé = Format(TxtDatelaitréalisé, "dd/mm/yyyy")
End Sub
Private Sub TxtMoispaye_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'optionnel : on réaffiche dans le textbox le format de la date
TxtMoispaye = Format(TxtMoispaye, "dd/mm/yyyy")
End Sub
 
Private Sub UserForm_Initialize()
UsfNouvelleFiche.MultiPage1.Value = 0
TxtDate = Date
TxtCoûtFièvreLait.Value = Sheets("Data").Range("Cout_Fièvre_De_Lait")
TxtCoutVélageDif.Value = Sheets("Data").Range("Cout_Vélage_Difficile")
TxtCoutNonDélivrance.Value = Sheets("Data").Range("Cout_Non_Délivrance")
TxtCoutCetose.Value = Sheets("Data").Range("Cout_Cétose")
TxtCoutDeplcCaillette.Value = Sheets("Data").Range("Cout_Déplacement_Caillette")
TxtCoutMammites.Value = Sheets("Data").Range("Cout_Mammite")
TxtCoutBoiterie.Value = Sheets("Data").Range("Cout_Boiterie")
TxtCoutMétrites.Value = Sheets("Data").Range("Cout_Métrite")
TxtCoutCyclesPerdus.Value = Sheets("Data").Range("Cout_Cycle_Perdu")
TxtCoutReformeAntcip.Value = Sheets("Data").Range("Cout_Réforme_anticipée")
TxtCoutVachesMortes.Value = Sheets("Data").Range("Cout_Vache_Morte")
TxtCoûtVeauMort.Value = Sheets("Data").Range("Cout_Veau_Mort")
 
TxtCoutCult1 = 0
TxtRdtCult1 = 0
TxtCoutCult2 = 0
TxtRdtCult2 = 0
TxtCoutCult3 = 0
TxtRdtCult3 = 0
TxtCoutCult4 = 0
TxtRdtCult4 = 0
TxtCoutCult5 = 0
TxtRdtCult5 = 0
TxtCoutCult6 = 0
TxtRdtCult6 = 0
TxtCoutCult7 = 0
TxtRdtCult7 = 0
TxtCoutCult8 = 0
TxtRdtCult8 = 0
TxtCoutCult9 = 0
TxtRdtCult9 = 0
TxtCoutCult10 = 0
TxtRdtCult10 = 0
 
CboBouses1.Value = 0
CboBouses2.Value = 0
CboBouses3.Value = 0
CboBouses4.Value = 0
 
TxtNbFièvreLait = 0
TxtNbVélageDif = 0
TxtNbNonDélivrance = 0
TxtNbCétose = 0
TxtNbDeplcCaillette = 0
TxtNbMammittes = 0
TxtNbBoiterie = 0
TxtNbMétrites = 0
TxtNbCyclesPerdus = 0
TxtNbReformeAntcip = 0
TxtNbVachesMortes = 0
TxtNbVeauMort = 0
 
TxtLivraisonpossible = 0
TxtDatefincampagne = 0
TxtNbmoyenVLcampagne = 0
TxtLaittank = 0
TxtTraitetank = 4
TxtVltank = 0
TxtDatelaitréalisé = 0
TxtLaitréalisé = 0
TxtVlfincampagne = 0
TxtMoispaye = 0
TxtPrixlaitnet = 0
TxtTb = 38
TxtTp = 32
TxtUrée = 0
TxtCellules = 0
 
TxtAnnuitées = 0
TxtAnnuitNouv = 0
TxtFfct = 0
TxtBesoinsPrivés = 0
TxtVariPp = 0
TxtMargeSecu = 0
TxtTotalCharges = 0
TxtChargesExept = 0
TxtChargesFi = 0
TxtAmort = 0
TxtTotalPdt = 0
TxtPdtLait = 0
TxtPdtExept = 0
TxtLaitPdt = 0
TxtLaitPlus = 0
TxtPrixLaitAn = 0
 
 
 
    End Sub
 
Function TrouveType(V)
TrouveType = V
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function
If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function
If IsNumeric(Replace(TrouveType, ".", ",")) = True Then TrouveType = Replace(TrouveType, ",", "."): Exit Function
End Function
 
Private Sub CmdValiderFiche_Click()
     Dim DMonth As Integer
     Dim SrcRng As Range
     Dim SumVal  As Double, CntVal As Integer
     Dim RowN As Integer, ColN As Integer
 
Application.ScreenUpdating = False
 
    Sheets("Fiche").Range("AX11") = TrouveType(TxtDate)
 
With Sheets("Data_Système").ListObjects("Données_Système")
    If .ListRows.Count = 0 Then
        Range("Données_Système[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Système[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_système").ListObjects("Données_Système").ListRows(1)
    Else
        Set LignTablo = Range("Données_Système").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
 
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(TxtObjectifs)
    .Cells(1, 3) = TrouveType(TxtVl)
    .Cells(1, 4) = TrouveType(TxtG2)
    .Cells(1, 5) = TrouveType(TxtG12)
    .Cells(1, 6) = TrouveType(TxtG1)
    .Cells(1, 7) = TrouveType(TxtBoeufs)
    .Cells(1, 8) = TrouveType(TxtTaurillons)
    .Cells(1, 9) = TrouveType(TxtAnx1)
    .Cells(1, 10) = TrouveType(TxtAnx2)
    .Cells(1, 11) = TrouveType(CboDistrifourrage)
    .Cells(1, 12) = TrouveType(Cbodistriconcentrés)
    .Cells(1, 13) = TrouveType(CboTraite)
    .Cells(1, 14) = TrouveType(CboLaiterie)
    .Cells(1, 15) = TrouveType(CboNbPointdeau)
    .Cells(1, 16) = TrouveType(TxtPlacecornadis)
    .Cells(1, 17) = TrouveType(CboCouchage)
    .Cells(1, 18) = TrouveType(CboStabupature)
    .Cells(1, 19) = TrouveType(TxtObservations)
    .Cells(1, 20) = TrouveType(TxtSau)
    .Cells(1, 21) = TrouveType(CboCulture1)
    .Cells(1, 22) = TrouveType(TxtSurfcult1)
    .Cells(1, 23) = TrouveType(TxtCoutCult1)
    .Cells(1, 24) = TrouveType(TxtRdtCult1)
    .Cells(1, 25) = TrouveType(CboCulture2)
    .Cells(1, 26) = TrouveType(TxtSurfcult2)
    .Cells(1, 27) = TrouveType(TxtCoutCult2)
    .Cells(1, 28) = TrouveType(TxtRdtCult2)
    .Cells(1, 29) = TrouveType(CboCulture3)
    .Cells(1, 30) = TrouveType(TxtSurfcult3)
    .Cells(1, 31) = TrouveType(TxtCoutCult3)
    .Cells(1, 32) = TrouveType(TxtRdtCult3)
    .Cells(1, 33) = TrouveType(CboCulture4)
    .Cells(1, 34) = TrouveType(TxtSurfcult4)
    .Cells(1, 35) = TrouveType(TxtCoutCult4)
    .Cells(1, 36) = TrouveType(TxtRdtCult4)
    .Cells(1, 37) = TrouveType(CboCulture5)
    .Cells(1, 38) = TrouveType(TxtSurfcult5)
    .Cells(1, 39) = TrouveType(TxtCoutCult5)
    .Cells(1, 40) = TrouveType(TxtRdtCult5)
    .Cells(1, 41) = TrouveType(CboCulture6)
    .Cells(1, 42) = TrouveType(TxtSurfcult6)
    .Cells(1, 43) = TrouveType(TxtCoutCult6)
    .Cells(1, 44) = TrouveType(TxtRdtCult6)
    .Cells(1, 45) = TrouveType(CboCulture7)
    .Cells(1, 46) = TrouveType(TxtSurfcult7)
    .Cells(1, 47) = TrouveType(TxtCoutCult7)
    .Cells(1, 48) = TrouveType(TxtRdtCult7)
    .Cells(1, 49) = TrouveType(CboCulture8)
    .Cells(1, 50) = TrouveType(TxtSurfcult8)
    .Cells(1, 51) = TrouveType(TxtCoutCult8)
    .Cells(1, 52) = TrouveType(TxtRdtCult8)
    .Cells(1, 53) = TrouveType(CboCulture9)
    .Cells(1, 54) = TrouveType(TxtSurfcult9)
    .Cells(1, 55) = TrouveType(TxtCoutCult9)
    .Cells(1, 56) = TrouveType(TxtRdtCult9)
    .Cells(1, 57) = TrouveType(CboCulture10)
    .Cells(1, 58) = TrouveType(TxtSurfcult10)
    .Cells(1, 59) = TrouveType(TxtCoutCult10)
    .Cells(1, 60) = TrouveType(TxtRdtCult10)
 
If (TxtRdtCult1) <> 0 Then
    .Cells(1, 61) = TrouveType(TxtCoutCult1) / (TxtRdtCult1)
Else: .Cells(Ligne, 61) = 0
End If
 
If (TxtRdtCult2) <> 0 Then
    .Cells(1, 62) = TrouveType(TxtCoutCult2) / (TxtRdtCult2)
Else: .Cells(Ligne, 62) = 0
End If
 
    If (TxtRdtCult3) <> 0 Then
    .Cells(1, 63) = TrouveType(TxtCoutCult3) / (TxtRdtCult3)
Else: .Cells(Ligne, 63) = 0
End If
 
    If (TxtRdtCult4) <> 0 Then
    .Cells(1, 64) = TrouveType(TxtCoutCult4) / (TxtRdtCult4)
Else: .Cells(Ligne, 64) = 0
End If
 
    If (TxtRdtCult5) <> 0 Then
    .Cells(1, 65) = TrouveType(TxtCoutCult5) / (TxtRdtCult5)
Else: .Cells(Ligne, 65) = 0
End If
 
    If (TxtRdtCult6) <> 0 Then
    .Cells(1, 66) = TrouveType(TxtCoutCult6) / (TxtRdtCult6)
Else: .Cells(Ligne, 66) = 0
End If
 
    If (TxtRdtCult7) <> 0 Then
    .Cells(1, 67) = TrouveType(TxtCoutCult7) / (TxtRdtCult7)
Else: .Cells(Ligne, 67) = 0
End If
 
    If (TxtRdtCult8) <> 0 Then
    .Cells(1, 68) = TrouveType(TxtCoutCult8) / (TxtRdtCult8)
Else: .Cells(Ligne, 68) = 0
End If
 
    If (TxtRdtCult9) <> 0 Then
    .Cells(1, 69) = TrouveType(TxtCoutCult9) / (TxtRdtCult9)
Else: .Cells(Ligne, 69) = 0
End If
 
    If (TxtRdtCult10) <> 0 Then
    .Cells(1, 70) = TrouveType(TxtCoutCult10) / (TxtRdtCult10)
Else: .Cells(Ligne, 70) = 0
End If
 
End With
 
With Sheets("Data_Troupeau").ListObjects("Données_Troupeau")
    If .ListRows.Count = 0 Then
        Range("Données_Troupeau[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Troupeau[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_Troupeau").ListObjects("Données_Troupeau").ListRows(1)
    Else
        Set LignTablo = Range("Données_Troupeau").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(CboPoidsVl)
    .Cells(1, 3) = TrouveType(CboNecmoyen)
    .Cells(1, 4) = TrouveType(TxtProductionpic)
    .Cells(1, 5) = TrouveType(CboPrimipares)
    .Cells(1, 6) = TrouveType(TxtMoismoyen)
    .Cells(1, 7) = TrouveType(TxtMoisgestation)
    .Cells(1, 8) = TrouveType(TxtOblLaitVlAn)
    .Cells(1, 9) = TrouveType(CboBouses1)
    .Cells(1, 10) = TrouveType(CboBouses2)
    .Cells(1, 11) = TrouveType(CboBouses3)
    .Cells(1, 12) = TrouveType(CboBouses4)
 
    .Cells(1, 13) = TrouveType(100) - (CboBouses1) - (CboBouses2) - (CboBouses3) - (CboBouses4)
 
    .Cells(1, 14) = TrouveType(TxtBouses)
    .Cells(1, 15) = TrouveType(TxtNbFièvreLait)
    .Cells(1, 16) = TrouveType(TxtCoûtFièvreLait)
    .Cells(1, 17) = TrouveType(TxtNbVélageDif)
    .Cells(1, 18) = TrouveType(TxtCoutVélageDif)
    .Cells(1, 19) = TrouveType(TxtNbNonDélivrance)
    .Cells(1, 20) = TrouveType(TxtCoutNonDélivrance)
    .Cells(1, 21) = TrouveType(TxtNbCétose)
    .Cells(1, 22) = TrouveType(TxtCoutCetose)
    .Cells(1, 23) = TrouveType(TxtNbDeplcCaillette)
    .Cells(1, 24) = TrouveType(TxtCoutDeplcCaillette)
    .Cells(1, 25) = TrouveType(TxtNbMammittes)
    .Cells(1, 26) = TrouveType(TxtCoutMammittes)
    .Cells(1, 27) = TrouveType(TxtNbBoiterie)
    .Cells(1, 28) = TrouveType(TxtCoutBoiterie)
    .Cells(1, 29) = TrouveType(TxtNbMétrites)
    .Cells(1, 30) = TrouveType(TxtCoutMétrites)
    .Cells(1, 31) = TrouveType(TxtNbCyclesPerdus)
    .Cells(1, 32) = TrouveType(TxtCoutCyclesPerdus)
    .Cells(1, 33) = TrouveType(TxtNbReformeAntcip)
    .Cells(1, 34) = TrouveType(TxtCoutReformeAntcip)
    .Cells(1, 35) = TrouveType(TxtNbVachesMortes)
    .Cells(1, 36) = TrouveType(TxtCoutVachesMortes)
    .Cells(1, 37) = TrouveType(TxtNbVeauMort)
    .Cells(1, 38) = TrouveType(TxtCoûtVeauMort)
    .Cells(1, 39) = TrouveType(Txt1IA)
    .Cells(1, 40) = TrouveType(Txt3IA)
    .Cells(1, 41) = TrouveType(TxtIAVeau)
    .Cells(1, 42) = TrouveType(TxtIVIAF)
    .Cells(1, 43) = TrouveType(TxtIVV)
 
    .Cells(1, 45) = TrouveType(TxtNbFièvreLait) * (TxtCoûtFièvreLait)
    .Cells(1, 46) = TrouveType(TxtNbVélageDif) * (TxtCoutVélageDif)
    .Cells(1, 47) = TrouveType(TxtNbNonDélivrance) * (TxtCoutNonDélivrance)
    .Cells(1, 48) = TrouveType(TxtNbCétose) * (TxtCoutCetose)
    .Cells(1, 49) = TrouveType(TxtNbDeplcCaillette) * (TxtCoutDeplcCaillette)
    .Cells(1, 50) = TrouveType(TxtNbMammittes) * (TxtCoutMammittes)
    .Cells(1, 51) = TrouveType(TxtNbBoiterie) * (TxtCoutBoiterie)
    .Cells(1, 52) = TrouveType(TxtNbMétrites) * (TxtCoutMétrites)
    .Cells(1, 53) = TrouveType(TxtNbCyclesPerdus) * (TxtCoutCyclesPerdus)
    .Cells(1, 54) = TrouveType(TxtCoutReformeAntcip) * (TxtCoutReformeAntcip)
    .Cells(1, 55) = TrouveType(TxtNbVachesMortes) * (TxtCoutVachesMortes)
    .Cells(1, 56) = TrouveType(TxtNbVeauMort) * (TxtCoûtVeauMort)
 
    .Cells(1, 57) = TrouveType(TxtNbFièvreLait) * (TxtCoûtFièvreLait) _
                                + (TxtNbVélageDif) * (TxtCoutVélageDif) _
                                + (TxtNbNonDélivrance) * (TxtCoutNonDélivrance) _
                                + (TxtNbCétose) * (TxtCoutCetose) _
                                + (TxtNbDeplcCaillette) * (TxtCoutDeplcCaillette) _
                                + (TxtNbMammittes) * (TxtCoutMammittes) _
                                + (TxtNbBoiterie) * (TxtCoutBoiterie) _
                                + (TxtNbMétrites) * (TxtCoutMétrites) _
                                + (TxtNbCyclesPerdus) * (TxtCoutCyclesPerdus) _
                                + (TxtCoutReformeAntcip) * (TxtCoutReformeAntcip) _
                                + (TxtNbVachesMortes) * (TxtCoutVachesMortes) _
                                + (TxtNbVeauMort) * (TxtCoûtVeauMort)
 
End With
 
 
 
 
With Sheets("Data_Compta").ListObjects("Données_Compta")
    If .ListRows.Count = 0 Then
        Range("Données_Compta[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Compta[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_Compta").ListObjects("Données_Compta").ListRows(1)
    Else
        Set LignTablo = Range("Données_Compta").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(TxtAnnuitées)
    .Cells(1, 3) = TrouveType(TxtAnnuitNouv)
    .Cells(1, 4) = TrouveType(TxtFfct)
    .Cells(1, 5) = TrouveType(TxtBesoinsPrivés)
    .Cells(1, 6) = TrouveType(TxtVariPp)
    .Cells(1, 7) = TrouveType(TxtMargeSecu)
    .Cells(1, 8) = TrouveType(TxtTotalCharges)
    .Cells(1, 9) = TrouveType(TxtChargesExept)
    .Cells(1, 10) = TrouveType(TxtChargesFi)
    .Cells(1, 11) = TrouveType(TxtAmort)
    .Cells(1, 12) = TrouveType(TxtTotalPdt)
    .Cells(1, 13) = TrouveType(TxtPdtLait)
    .Cells(1, 14) = TrouveType(TxtPdtExept)
    .Cells(1, 15) = TrouveType(TxtLaitPdt)
    .Cells(1, 16) = TrouveType(TxtLaitPlus)
    .Cells(1, 17) = TrouveType(TxtPrixLaitAn)
    .Cells(1, 18) = TrouveType(TxtQtéConcVlAn)
    .Cells(1, 19) = TrouveType(TxtQtéConcVl1000l)
    .Cells(1, 20) = TrouveType(TxtMoyQtéConcentré)
    .Cells(1, 21) = TrouveType(TxtPrixConcVlAn)
    .Cells(1, 22) = TrouveType(TxtPrixConcVl1000l)
    .Cells(1, 23) = TrouveType(TxtMoyprixConcentré)
    .Cells(1, 24) = TrouveType(TxtFraisVétoVlAn)
    .Cells(1, 25) = TrouveType(TxtFraisVéto1000L)
    .Cells(1, 26) = TrouveType(TxtMoyFraisVéto1000L)
    .Cells(1, 27) = TrouveType(TxtFraisElevageVlAn)
    .Cells(1, 28) = TrouveType(TxtFraisElevage1000L)
    .Cells(1, 29) = TrouveType(TxtMoyFraisElevage1000L)
 
    .Cells(1, 30) = TrouveType((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu)
 
    .Cells(1, 31) = TrouveType(TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))
 
    .Cells(1, 32) = TrouveType((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))) _
                                + ((TxtTotalCharges) - (TxtChargesExept) - (TxtChargesFi) - (TxtAmort))
 
    .Cells(1, 33) = TrouveType(((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))) _
                                + ((TxtTotalCharges) - (TxtChargesExept) - (TxtChargesFi) - (TxtAmort))) _
                                - (TxtTotalPdt) + (TxtPdtLait) + (TxtPdtExept)
 
If (TxtLaitPdt) Or (TxtLaitPlus) <> 0 Then
    .Cells(1, 34) = ((((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))) _
                                + ((TxtTotalCharges) - (TxtChargesExept) - (TxtChargesFi) - (TxtAmort))) _
                                - (TxtTotalPdt) + (TxtPdtLait) + (TxtPdtExept)) _
                                / (((TxtLaitPdt) + (TxtLaitPlus)) * 1000)
 
    .Cells(1, 35) = TrouveType(TxtPrixLaitAn) - ((((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp) _
                                + (((TxtAnnuitées) + (TxtAnnuitNouv) + (TxtFfct) + (TxtBesoinsPrivés) + (TxtVariPp)) * (TxtMargeSecu))) _
                                + ((TxtTotalCharges) - (TxtChargesExept) - (TxtChargesFi) - (TxtAmort))) _
                                - (TxtTotalPdt) + (TxtPdtLait) + (TxtPdtExept)) _
                                / (((TxtLaitPdt) + (TxtLaitPlus)) * 1000)
Else: .Cells(Ligne, 34) = 0
      .Cells(Ligne, 35) = 0
End If
 
End With
 
 
With Sheets("Data_Ration").ListObjects("Données_Ration")
    If .ListRows.Count = 0 Then
        Range("Données_Ration[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Ration[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_Ration").ListObjects("Données_Ration").ListRows(1)
        Else
        Set LignTablo = Range("Données_Ration").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(TxtNbRationsInit)
    .Cells(1, 3) = TrouveType(CbxTypeRationInit)
    .Cells(1, 4) = TrouveType(CbxAlt1Init)
    .Cells(1, 5) = TrouveType(TxtAlt1Init)
    .Cells(1, 6) = TrouveType(TxtCoutAlt1Init)
    .Cells(1, 7) = TrouveType(CbxAlt2Init)
    .Cells(1, 8) = TrouveType(TxtAlt2Init)
    .Cells(1, 9) = TrouveType(TxtCoutAlt2Init)
    .Cells(1, 10) = TrouveType(CbxAlt3Init)
    .Cells(1, 11) = TrouveType(TxtAlt3Init)
    .Cells(1, 12) = TrouveType(TxtCoutAlt3Init)
    .Cells(1, 13) = TrouveType(CbxAlt4Init)
    .Cells(1, 14) = TrouveType(TxtAlt4Init)
    .Cells(1, 15) = TrouveType(TxtCoutAlt4Init)
    .Cells(1, 16) = TrouveType(CbxAlt5Init)
    .Cells(1, 17) = TrouveType(TxtAlt5Init)
    .Cells(1, 18) = TrouveType(TxtCoutAlt5Init)
    .Cells(1, 19) = TrouveType(CbxAlt6Init)
    .Cells(1, 20) = TrouveType(TxtAlt6Init)
    .Cells(1, 21) = TrouveType(TxtCoutAlt6Init)
    .Cells(1, 22) = TrouveType(CbxAlt7Init)
    .Cells(1, 23) = TrouveType(TxtAlt7Init)
    .Cells(1, 24) = TrouveType(TxtCoutAlt7Init)
    .Cells(1, 25) = TrouveType(CbxAlt8Init)
    .Cells(1, 26) = TrouveType(TxtAlt8Init)
    .Cells(1, 27) = TrouveType(TxtCoutAlt8Init)
    .Cells(1, 28) = TrouveType(CbxAlt9Init)
    .Cells(1, 29) = TrouveType(TxtAlt9Init)
    .Cells(1, 30) = TrouveType(TxtCoutAlt9Init)
    .Cells(1, 31) = TrouveType(CbxAlt10Init)
    .Cells(1, 32) = TrouveType(TxtAlt10Init)
    .Cells(1, 33) = TrouveType(TxtCoutAlt10Init)
    .Cells(1, 34) = TrouveType(CbxAlt11Init)
    .Cells(1, 35) = TrouveType(TxtAlt11Init)
    .Cells(1, 36) = TrouveType(TxtCoutAlt11Init)
    .Cells(1, 37) = TrouveType(CbxAlt12Init)
    .Cells(1, 38) = TrouveType(TxtAlt12Init)
    .Cells(1, 39) = TrouveType(TxtCoutAlt12Init)
    .Cells(1, 40) = TrouveType(CbxAlt13Init)
    .Cells(1, 41) = TrouveType(TxtAlt13Init)
    .Cells(1, 42) = TrouveType(TxtCoutAlt13Init)
    .Cells(1, 43) = TrouveType(CbxAlt14Init)
    .Cells(1, 44) = TrouveType(TxtAlt14Init)
    .Cells(1, 45) = TrouveType(TxtCoutAlt14Init)
    .Cells(1, 46) = TrouveType(CbxAlt15Init)
    .Cells(1, 47) = TrouveType(TxtAlt15Init)
    .Cells(1, 48) = TrouveType(TxtCoutAlt15Init)
    .Cells(1, 49) = TrouveType(TxtQtéConcentréProduction)
    .Cells(1, 50) = TrouveType(TxtPrixKgConcentréProduction)
 
    .Cells(1, 52) = TrouveType(TxtNbRationsCor)
    .Cells(1, 53) = TrouveType(CbxTypeRationCor)
    .Cells(1, 54) = TrouveType(CbxAlt1Cor)
    .Cells(1, 55) = TrouveType(TxtAlt1Cor)
    .Cells(1, 56) = TrouveType(TxtCoutAlt1Cor)
    .Cells(1, 57) = TrouveType(CbxAlt2Cor)
    .Cells(1, 58) = TrouveType(TxtAlt2Cor)
    .Cells(1, 59) = TrouveType(TxtCoutAlt2Cor)
    .Cells(1, 60) = TrouveType(CbxAlt3Cor)
    .Cells(1, 61) = TrouveType(TxtAlt3Cor)
    .Cells(1, 62) = TrouveType(TxtCoutAlt3Cor)
    .Cells(1, 63) = TrouveType(CbxAlt4Cor)
    .Cells(1, 64) = TrouveType(TxtAlt4Cor)
    .Cells(1, 65) = TrouveType(TxtCoutAlt4Cor)
    .Cells(1, 66) = TrouveType(CbxAlt5Cor)
    .Cells(1, 67) = TrouveType(TxtAlt5Cor)
    .Cells(1, 68) = TrouveType(TxtCoutAlt5Cor)
    .Cells(1, 69) = TrouveType(CbxAlt6Cor)
    .Cells(1, 70) = TrouveType(TxtAlt6Cor)
    .Cells(1, 71) = TrouveType(TxtCoutAlt6Cor)
    .Cells(1, 72) = TrouveType(CbxAlt7Cor)
    .Cells(1, 73) = TrouveType(TxtAlt7Cor)
    .Cells(1, 74) = TrouveType(TxtCoutAlt7Cor)
    .Cells(1, 75) = TrouveType(CbxAlt8Cor)
    .Cells(1, 76) = TrouveType(TxtAlt8Cor)
    .Cells(1, 77) = TrouveType(TxtCoutAlt8Cor)
    .Cells(1, 78) = TrouveType(CbxAlt9Cor)
    .Cells(1, 79) = TrouveType(TxtAlt9Cor)
    .Cells(1, 80) = TrouveType(TxtCoutAlt9Cor)
    .Cells(1, 81) = TrouveType(CbxAlt10Cor)
    .Cells(1, 82) = TrouveType(TxtAlt10Cor)
    .Cells(1, 83) = TrouveType(TxtCoutAlt10Cor)
    .Cells(1, 84) = TrouveType(CbxAlt11Cor)
    .Cells(1, 85) = TrouveType(TxtAlt11Cor)
    .Cells(1, 86) = TrouveType(TxtCoutAlt11Cor)
    .Cells(1, 87) = TrouveType(CbxAlt12Cor)
    .Cells(1, 88) = TrouveType(TxtAlt12Cor)
    .Cells(1, 89) = TrouveType(TxtCoutAlt12Cor)
    .Cells(1, 90) = TrouveType(CbxAlt13Cor)
    .Cells(1, 91) = TrouveType(TxtAlt13Cor)
    .Cells(1, 92) = TrouveType(TxtCoutAlt13Cor)
    .Cells(1, 93) = TrouveType(CbxAlt14Cor)
    .Cells(1, 94) = TrouveType(TxtAlt14Cor)
    .Cells(1, 95) = TrouveType(TxtCoutAlt14Cor)
    .Cells(1, 96) = TrouveType(CbxAlt15Cor)
    .Cells(1, 97) = TrouveType(TxtAlt15Cor)
    .Cells(1, 98) = TrouveType(TxtCoutAlt15Cor)
 
If Sheets("Fiche").Range("Nb_Rations_Initiale") Or Sheets("Fiche").Range("Total_Ingestion_MS_Ration_Initiale") <> 0 Then
    .Cells(1, 100) = Sheets("Fiche").Range("Total_Ingestion_MS_Ration_Initiale") + Sheets("Fiche").Range("Qté_jour_conc_produc_troupeau") / Sheets("Fiche").Range("Nb_Rations_Initiale")
Else: .Cells(Ligne, 100) = 0
End If
 
End With
With Sheets("Data_lait").ListObjects("Données_Lait")
    If .ListRows.Count = 0 Then
        Range("Données_Lait[[#Headers],[Date]]").Offset(1, 0) = 1
        Range("Données_Lait[[#Headers],[Date]]").Offset(1, 0) = ""
    End If
 
    If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then
        Set LignTablo = Sheets("Data_lait").ListObjects("Données_Lait").ListRows(1)
    Else
        Set LignTablo = Range("Données_Lait").ListObject.ListRows.Add(AlwaysInsert:=True)
    End If
End With
 
With LignTablo.Range
    .Cells(1, 1) = TrouveType(TxtDate)
    .Cells(1, 2) = TrouveType(TxtLivraisonpossible)
    .Cells(1, 3) = TrouveType(TxtDatefincampagne)
    .Cells(1, 4) = TrouveType(TxtNbmoyenVLcampagne)
    .Cells(1, 5) = TrouveType(TxtLaittank)
    .Cells(1, 6) = TrouveType(TxtTraitetank)
    .Cells(1, 7) = TrouveType(TxtVltank)
    .Cells(1, 8) = TrouveType(TxtDatelaitréalisé)
    .Cells(1, 9) = TrouveType(TxtLaitréalisé)
    .Cells(1, 10) = TrouveType(TxtVlfincampagne)
    .Cells(1, 11) = TrouveType(TxtMoispaye)
    .Cells(1, 12) = TrouveType(TxtPrixlaitnet)
    .Cells(1, 13) = TrouveType(TxtTb)
    .Cells(1, 14) = TrouveType(TxtTp)
    .Cells(1, 15) = TrouveType(TxtUrée)
    .Cells(1, 16) = TrouveType(TxtCellules)
 
   'Calcul  Nb moyen Vl depuis le début de la campagne
    Set SrcRng = ThisWorkbook.Worksheets("Data_Lait").Range("A5").CurrentRegion
CntVal = 0
SumVal = 0
 
 For RowN = 2 To SrcRng.Rows.Count
 
 If IsDate(SrcRng(RowN, 1)) Then     'Peut être supprimé si c'est toujours une date
        DMonth = Month(SrcRng(RowN, 1))
        Debug.Print RowN, SrcRng(RowN, 1), DMonth
 
        If DMonth = 4 Then
            CntVal = 0
            SumVal = 0
   End If
 
        CntVal = CntVal + 1
        SumVal = SumVal + SrcRng(RowN, 7)
        SrcRng(RowN, 17) = SumVal / CntVal
 
 End If
Next RowN
 
   'calcul du lait total restant à livrer
    .Cells(1, 18) = TrouveType(TxtLivraisonpossible) - (TxtLaitréalisé)
 
     'calcul lait à livrer par vl par jour sur la campagne
If Val(TrouveType(TxtNbmoyenVLcampagne)) = 0 Then
    .Cells(Ligne, 19) = 0
Else: .Cells(1, 19) = Val(TrouveType(TxtLivraisonpossible)) / 365 / (TxtNbmoyenVLcampagne)
End If
 
'calcul lait livré par vl depuis début de campagne
If Val(TrouveType(TxtDatefincampagne)) Or (TxtDatelaitréalisé) Or (TxtLivraisonpossible) Or (TxtLaitréalisé) = 0 Then
     .Cells(Ligne, 20) = 0
Else: .Cells(1, 20) = Val((TrouveType(TxtLaitréalisé)) / (365 - ((TxtDatefincampagne) - (TxtDatelaitréalisé)))) / Sheets("Fiche").Range("VL_moyen_depuis_début_campagne")
End If
 
    'calcul lait restant à livrer par vl jusqu'à fin de campagne
If Val(TrouveType(TxtDatefincampagne)) Or (TxtDatelaitréalisé) Or (TxtVlfincampagne) = 0 Then
    .Cells(Ligne, 21) = 0
Else: .Cells(1, 21) = ((Val(TrouveType(TxtLivraisonpossible)) - (TxtLaitréalisé)) / ((TxtDatefincampagne) - (TxtDatelaitréalisé))) / (TxtVlfincampagne)
End If
 
    'Calcul Pl réelle/ VL/jour
If Val(TrouveType(TxtLaittank)) Or (TxtVltank) = 0 Then
    .Cells(Ligne, 22) = 0
 Else: .Cells(1, 22) = Val(TrouveType(TxtLaittank)) / (TxtVltank) / ((TxtTraitetank) / 2)
End If
 
'Calcul lait à 70 par VL par jour
If Val(TrouveType(TxtLaittank)) Or (TxtVltank) = 0 Then
    .Cells(Ligne, 23) = 0
 Else: .Cells(1, 23) = Val(TrouveType((TxtLaittank)) / (TxtVltank) / ((TxtTraitetank) / 2)) * (TxtTb) * (TxtTp) / 70
End If
 
 'Calcul lait vendu par VL /jour
If Val(TrouveType(TxtLaittank)) Or (TxtVltank) = 0 Then
    .Cells(Ligne, 24) = 0
 Else: .Cells(1, 24) = Val(TrouveType((TxtLaittank)) / (TxtVltank) / ((TxtTraitetank) / 2)) * (TxtTb) * (TxtTp)
End If
 
  'Calcul lait vendu par VL /jour
If Val(TrouveType(TxtLaittank)) Or (TxtVltank) Or (TxtTraitetank) Or (TxtPrixlaitnet) = 0 Then
     .Cells(Ligne, 25) = 0
 Else: .Cells(1, 25) = Val(TrouveType((TxtLaittank)) / (TxtVltank) / ((TxtTraitetank) / 2)) * (TxtPrixlaitnet)
End If
 
 'Calcul cout ration / 1000 L
If Val(TrouveType(TxtLaittank)) Or (TxtVltank) Or (TxtTraitetank) Or (TxtPrixlaitnet) = 0 Then
.Cells(Ligne, 26) = 0
 Else: .Cells(1, 26) = Val(TrouveType(Sheets("Fiche").Range("cout_ration_VL_j_Ration_Initiale") * 1000)) / ((TxtLaittank) / (TxtVltank) / ((TxtTraitetank) / 2))
End If
 
End With
 
Unload Me
 
End Sub
 
Private Sub CmdAnnuler_Click()
Me.Hide
End Sub

Joël

Invité · 07/11/2014, 09h21

Bonjour,
Excel à une véritable passion c'est d’interpréter les valeur saisies par l'utilisateur; pour t'en convaincre, écrits dans Excel 1/2/14 excel va l'interpréter en 01/02/2014.

TrouveType n'a pas pour objet de convertir les dates en dates les numériques en numériques mais de formater les données pour forcer Excel à interpréter les données de façon univoque.

les dates en 2014-02-01 les numérique en "2.25".

si je faits 5 / "2.25" Erreur 5 / val("2.25") OK.

**joel50** · 07/11/2014, 09h46

Bonjour Robert, bonjour à tous

Merci de ces éclaircissement, effectivement, j'ai n'avais pas compris l'objet réel de la fonction "TrouveType", ça l’éclairci "un peu" l'esprit. Je peu comprendre vite, mais il faut quelquefois m'expliquer longtemps

Pour ma compréhension, (et peu être d'autre amateur comme moi) si je résume, on utilise TrouveType pour "réécrire" les données dans excel afin qu'il les interprètent comme on le souhaite. Ce qui ne les convertis pas afin de pouvoir les traiter mathématiquement en VBA, je dois donc les précéder des conversions (Val, Cdate...)

Je vais essayer de remettre en ordre l'ensemble du code ou je vais penser nécessaire d'y ajouté la conversion .

Joël

Invité · 07/11/2014, 10h09

exactement car les valeurs retourné par Trouvetype sont des variants; je n'es pas précisé de type de retournement de la fonction!

Code :

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

1
2
3
4
5
Function TrouveType(V)' type variant
Function TrouveType(V) as date 'Type date
Function TrouveType(V) as string 'type texte
Function TrouveType(V) as integer 'type entier
Function TrouveType(V) as double 'type décimale

si je type m'a fonction en string excel écrira les date 2014-02-01; en ne typant pas ma fonction j'oblige Excel à cogiter!

le problème des numérique est val attend un format "2.25" et que Cdbl attend "2,25"; pour les dates cdate suffi pour les numérique le choix en fonction du format des données "2.25" ou "2,25" trouvetype converti systématiquement en "2.25" ça réduit le choix à val(trouvetype(......

**joel50** · 07/11/2014, 10h20

Merci

Je vais ajouté ces instructions à mon code, ou est il préférable de l'indiquer, en début de code ou dans la commande CmdValider.

Joël

Invité · 07/11/2014, 10h27

je te donne une réponse générale sans tenir compte de la réalité du code!

Code :

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

1
2
If val( TrouveType(Nomtextbox1)) =0 Then
If cdate(Nomtextbox1) =date  Then

bien sur tu ne change pas le type de retour de trouvetyp!

Code :

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

Function TrouveType(V)' type variant

**joel50** · 07/11/2014, 19h27

Plus ça va, moins ça va.
Je viens de modifier mon code avec le fonction TrouveType avec les conversions Val devant les chiffres et CDate devant les dates.
Plus rien ne fonctionne, sauf le fait de ne pas planter le code si données à zéro
.
Si je valorise la totalité des données de mon formulaire, plus aucun calcul ne se réalise.

Je ne ne charge pas les données en début de code avec zéro, le code bug.

Je n'ai certainement pas bien compris la syntaxe notamment avec les opérations, je regarde à l'écrire différement.

Extrait du code qui ne fonctionne pas.

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
 
     'calcul lait à livrer par vl par jour sur la campagne
If Val(TrouveType(TxtNbmoyenVLcampagne)) = 0 Then
    .Cells(Ligne, 19) = 0
Else: .Cells(1, 19) = Val(TrouveType(TxtLivraisonpossible)) / 365 / Val(TrouveType(TxtNbmoyenVLcampagne))
End If
 
'calcul lait livré par vl depuis début de campagne
If CDate(TrouveType(TxtDatefincampagne)) Or CDate(TrouveType(TxtDatelaitréalisé)) = 0 Then
     .Cells(Ligne, 20) = 0
Else: .Cells(1, 20) = Val((TrouveType(TxtLaitréalisé)) / (365 - (Val(TrouveType(TxtDatefincampagne)) - Val(TrouveType(TxtDatelaitréalisé))))) / Sheets("Fiche").Range("VL_moyen_depuis_début_campagne")
End If
 
    'calcul lait restant à livrer par vl jusqu'à fin de campagne
If CDate(TrouveType(TxtDatefincampagne)) Or CDate(TrouveType(TxtDatelaitréalisé)) Or Val(TrouveType(TxtVlfincampagne)) = 0 Then
    .Cells(Ligne, 21) = 0
Else: .Cells(1, 21) = ((Val(TrouveType(TxtLivraisonpossible)) - Val(TrouveType(TxtLaitréalisé))) / (Val(TrouveType(TxtDatefincampagne)) - Val(TrouveType(TxtDatelaitréalisé)))) / Val(TrouveType(TxtVlfincampagne))
End If
 
    'Calcul Pl réelle/ VL/jour
If Val(TrouveType(TxtLaittank)) Or Val(TrouveType(TxtVltank)) = 0 Then
    .Cells(Ligne, 22) = 0
 Else: .Cells(1, 22) = Val(TrouveType(TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2)
End If
 
'Calcul lait à 70 par VL par jour
If Val(TrouveType(TxtLaittank)) Or Val(TrouveType(TxtVltank)) = 0 Then
    .Cells(Ligne, 23) = 0
 Else: .Cells(1, 23) = Val(TrouveType((TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2)) * Val(TrouveType(TxtTb)) * Val(TrouveType(TxtTp)) / 70
End If
 
 'Calcul lait vendu par VL /jour
If Val(TrouveType(TxtLaittank)) Or Val(TrouveType(TxtVltank)) <> 0 Then
    .Cells(Ligne, 24) = 0
 Else: .Cells(1, 24) = Val(TrouveType((TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2)) * Val(TrouveType(TxtTb)) * Val(TrouveType(TxtTp))
End If
 
  'Calcul lait vendu par VL /jour
If Val(TrouveType(TxtLaittank)) Or Val(TrouveType(TxtVltank)) Or Val(TrouveType(TxtTraitetank)) Or Val(TrouveType(TxtPrixlaitnet)) = 0 Then
     .Cells(Ligne, 25) = 0
 Else: .Cells(1, 25) = Val(TrouveType((TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2)) * Val(TrouveType(TxtPrixlaitnet))
End If
 
 'Calcul cout ration / 1000 L
If Val(TrouveType(TxtLaittank)) Or Val(TrouveType(TxtVltank)) Or Val(TrouveType(TxtTraitetank)) Or Val(TrouveType(TxtPrixlaitnet)) = 0 Then
.Cells(Ligne, 26) = 0
 Else: .Cells(1, 26) = Val(TrouveType(Sheets("Fiche").Range("cout_ration_VL_j_Ration_Initiale") * 1000)) / (Val(TrouveType(TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2))
End If

Joël

Invité · 07/11/2014, 20h58

j"ai pas compris ce qui suit?

Code :

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

1
2
3
4
5
'calcul lait livré par vl depuis début de campagne
If CDate(TrouveType(TxtDatefincampagne)) Or CDate(TrouveType(TxtDatelaitréalisé)) = 0 Then
     .Cells(Ligne, 20) = 0
Else: .Cells(1, 20) = Val((TrouveType(TxtLaitréalisé)) / (365 - (Val(TrouveType(TxtDatefincampagne)) - Val(TrouveType(TxtDatelaitréalisé))))) / Sheets("Fiche").Range("VL_moyen_depuis_début_campagne")
End If

a OR b donne true si vrai sinon false!
tu n'as pas besoin CDate(TrouveType(TxtDatefincampagne)) pour les date CDate(TxtDatefincampagne)
retourne false CDate(TrouveType(TxtDatelaitréalisé)) = 0 car 01/02/2014 est bien <> 0

Code :

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

If CDate(TrouveType(TxtDatefincampagne)) Or CDate(TrouveType(TxtDatelaitréalisé)) Or Val(TrouveType(TxtVlfincampagne)) = 0 Then

même problème ne peut retourner que false

Code envisagable :

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

If CDate(TrouveType(TxtDatefincampagne))= date1 Or CDate(TrouveType(TxtDatelaitréalisé)) =Date2 Or Val(TrouveType(TxtVlfincampagne)) = 0 Then

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
Sub test()
 
 
     'calcul lait à livrer par vl par jour sur la campagne
If Val(TrouveType(TxtNbmoyenVLcampagne)) = 0 Then
    .Cells(Ligne, 19) = 0
Else: .Cells(1, 19) = Val(TrouveType(TxtLivraisonpossible)) / 365 / Val(TrouveType(TxtNbmoyenVLcampagne))
End If
 
'calcul lait livré par vl depuis début de campagne
If CDate(TrouveType(TxtDatefincampagne)) Or CDate(TrouveType(TxtDatelaitréalisé)) = 0 Then
     .Cells(Ligne, 20) = 0
Else: .Cells(1, 20) = Val((TrouveType(TxtLaitréalisé)) / (365 - (Val(TrouveType(TxtDatefincampagne)) - Val(TrouveType(TxtDatelaitréalisé))))) / Sheets("Fiche").Range("VL_moyen_depuis_début_campagne")
End If
 
    'calcul lait restant à livrer par vl jusqu'à fin de campagne
If CDate(TrouveType(TxtDatefincampagne)) Or CDate(TrouveType(TxtDatelaitréalisé)) Or Val(TrouveType(TxtVlfincampagne)) = 0 Then
    .Cells(Ligne, 21) = 0
Else: .Cells(1, 21) = ((Val(TrouveType(TxtLivraisonpossible)) - Val(TrouveType(TxtLaitréalisé))) / (Val(TrouveType(TxtDatefincampagne)) - Val(TrouveType(TxtDatelaitréalisé)))) / Val(TrouveType(TxtVlfincampagne))
End If
 
    'Calcul Pl réelle/ VL/jour
If Val(TrouveType(TxtLaittank)) * Val(TrouveType(TxtVltank)) = 0 Then
    .Cells(Ligne, 22) = 0
 Else: .Cells(1, 22) = Val(TrouveType(TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2)
End If
 
'Calcul lait à 70 par VL par jour
If Val(TrouveType(TxtLaittank)) * Val(TrouveType(TxtVltank)) = 0 Then
    .Cells(Ligne, 23) = 0
 Else: .Cells(1, 23) = Val(TrouveType((TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2)) * Val(TrouveType(TxtTb)) * Val(TrouveType(TxtTp)) / 70
End If
 
 'Calcul lait vendu par VL /jour
If Val(TrouveType(TxtLaittank)) * Val(TrouveType(TxtVltank)) = 0 Then
    .Cells(Ligne, 24) = 0
 Else: .Cells(1, 24) = Val(TrouveType((TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2)) * Val(TrouveType(TxtTb)) * Val(TrouveType(TxtTp))
End If
 
  'Calcul lait vendu par VL /jour
If Val(TrouveType(TxtLaittank)) * Val(TrouveType(TxtVltank)) * Val(TrouveType(TxtTraitetank)) * Val(TrouveType(TxtPrixlaitnet)) = 0 Then
     .Cells(Ligne, 25) = 0
 Else: .Cells(1, 25) = Val(TrouveType((TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2)) * Val(TrouveType(TxtPrixlaitnet))
End If
 
 'Calcul cout ration / 1000 L
If Val(TrouveType(TxtLaittank)) * Val(TrouveType(TxtVltank)) * Val(TrouveType(TxtTraitetank)) * Val(TrouveType(TxtPrixlaitnet)) = 0 Then
.Cells(Ligne, 26) = 0
 Else: .Cells(1, 26) = Val(TrouveType(Sheets("Fiche").Range("cout_ration_VL_j_Ration_Initiale") * 1000)) / (Val(TrouveType(TxtLaittank)) / Val(TrouveType(TxtVltank)) / (Val(TrouveType(TxtTraitetank)) / 2))
End If
End Sub

Compréhension If et IsEmpty

Macros et VBA Excel

Discussions similaires

Partager

Partager