Sub Hypothèsedecalcul()
Application.ScreenUpdating = False
Dim x As Single
With Sheets("Hypothèses de Calcul")
NbreCouche = .Range("A6") 'on récupère les infos d'entrée
.Range("B6") = 1
.Range("B6").AutoFill Destination:=Range("B6:B" & 5 + NbreCouche), Type:=xlFillSeries
Ninf = .Range("E3")
Lpieu = .Range("F3")
Phi = .Range("G3")
'quelques tests pour vérifier que les infos necessaires sont présentes. sinon. bug macro
If NbreCouche = "" Then
ManqueInfo = ManqueInfo & " NbreCouche "
End If
If Ninf = "" Then
ManqueInfo = ManqueInfo & " Ninf "
End If
If Lpieu = "" Then
ManqueInfo = ManqueInfo & " Lpieu "
End If
If Phi = "" Then
ManqueInfo = ManqueInfo & " Phi "
End If
If ManqueInfo <> "" Then
MsgBox ("il manque des infos: " & ManqueInfo)
Exit Sub
End If
End With
' on determine le type de sol dont le pieu est encastré
With Range("A3").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Valeurs a,b,c'!$B$2:$G$2"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
' on determine le type et la catégorie du pieu
With Range("B3").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Valeurs a,b,c'!$A$9:$A$28"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Range("A3:B3").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
' on determine le classe et la catégorie du pieu
Range("C3").FormulaR1C1 = "=VLOOKUP(RC[-1],'Valeurs a,b,c'!R8C1:R28C9,8,FALSE)"
Range("D3").FormulaR1C1 = "=VLOOKUP(RC[-2],'Valeurs a,b,c'!R8C1:R28C9,9,FALSE)"
' on prépare la liste déroulante pour le type de sol
With Range("C6").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="='Valeurs a,b,c'!$B$2:$G$2"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Range("C6").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("C6").Resize(NbreCouche).FillDown
Range("D6").Resize(NbreCouche, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A3").Select
Application.ScreenUpdating = True
End Sub