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
| Option Explicit
Private Sub result_Click()
diam12.Text = diam1.Text & " " & class1.Text & " " & qualite1.Text
diam13.Text = diam1.Text & " " & class2.Text & " " & qualite2.Text
Dim col1, col2, ligne1, ITal, ITab, D, Q1, Q2 As Integer
D = Val(diam1.Text)
Q1 = Val(qualite1.Text)
Q2 = Val(qualite2.Text)
With Worksheets("IT")
col1 = 2 + Val(qualite1.Text)
col2 = 2 + Val(qualite2.Text)
ligne1 = 5
While D < .Cells(ligne1, 1) Or D > .Cells(ligne1, 2)
ligne1 = ligne1 + 1
Wend
IT1.Value = .Cells(ligne1, col1)
IT2.Value = .Cells(ligne1, col2)
ITal = Val(IT1.Text)
ITab = Val(IT2.Text)
End With
'ecarts alesage'
Dim EIal, ESal As Double
Dim colal, cold, ligneal As Byte
Dim C1 As String
colal = 3
ligneal = 6
C1 = class1.Text
With Worksheets("alesages")
'ecart inferieur'
While D < .Cells(ligneal, 1) Or D > .Cells(ligneal, 2)
ligneal = ligneal + 1
Wend
While C1 <> .Cells(4, colal)
colal = colal + 1
Wend
EIal = CDbl(Replace(.Cells(ligneal, colal), "+D", ""))
If colal = 14 Then
EIal = -(ITal / 2)
End If
'ecart superieur'
Select Case Q1
Case 3
cold = 38
Case 4
cold = 39
Case Is = 5
cold = 40
Case 6
cold = 41
Case 7
cold = 42
Case Is = 8
cold = 43
End Select
If colal >= 15 Then
colal = 15
ligneal = 6
While C1 <> .Cells(4, colal)
colal = colal + 1
Wend
While D < .Cells(ligneal, 1) Or D > .Cells(ligneal, 2)
ligneal = ligneal + 1
Wend
If colal = 15 Then
colal = 15 - 6 + Q1
ESal = CDbl(Replace(.Cells(ligneal, colal), "+D", ""))
ElseIf colal = 18 And Q1 > 8 Then
colal = colal + 1
ElseIf colal = 20 And Q1 > 8 Then
colal = colal + 1
ElseIf colal = 23 And Q1 > 8 Then
colal = colal + 1
ElseIf colal = 18 Or colal = 20 Or colal = 23 Then
ESal = CDbl(Replace(.Cells(ligneal, colal), "+D", "")) + .Cells(ligneal, cold)
ElseIf colal >= 26 And Q1 <= 7 Then
ESal = (.Cells(ligneal, colal) + .Cells(ligneal, cold))
End If
EIal = ESal - ITal
End If
End With
ei1.Value = EIal
'ecarts arbre'
Dim ESab, EIab As Double
Dim colab, ligneab As Integer
Dim C2 As String
With Worksheets("arbres")
'ecart superieur'
Q2 = Val(qualite2.Text)
C2 = class2.Text
colab = 3
ligneab = 6
While C2 <> .Cells(4, colab)
colab = colab + 1
Wend
While D < .Cells(ligneab, 1) Or D > .Cells(ligneab, 2)
ligneab = ligneab + 1
Wend
ESab = .Cells(ligneab, colab)
If colab = 14 Then
ESab = ITab / 2
End If
'ecart inferieur'
If colab >= 15 Then
colab = 15
ligneab = 6
While C2 <> .Cells(4, colab)
colab = colab + 1
Wend
While D < .Cells(ligneab, 1) Or D > .Cells(ligneab, 2)
ligneab = ligneab + 1
Wend
If colab = 15 And Q2 <> 5 Then
colab = 15 - 6 + Q2
ElseIf colab = 15 And Q2 = 5 Then
colab = 15
ElseIf colab = 19 And Q2 <= 3 Then
colab = colab + 1
End If
EIab = .Cells(ligneab, colab)
ESab = EIab + ITab
End If
End With
es2.Value = ESab
es1.Value = EIal + ITal
ei2.Value = ESab - ITab
'Calcul des jeux MAXI et MINI
jma.Value = (ESal - EIab) / 1000
jmi.Value = (EIal - ESab) / 1000
End Sub |
Partager