Erreur introuvable
Bonjour,
Je me permets de vous solliciter car cela fait plusieurs heures que je cherche et je ne parviens pas à trouver ce qui bloque avec mon code.
Contexte : je veux créer un fichier pour mon boulot qui me permette de trouver le prix d'articles (en l’occurrence cylindre ou clé) en fonction de certaines informations saisie par l'utilisateur sur une feuille Excel.
Problème : quand mon code s'exécute (à chaque modification de ma feuille), il tourne sans s'arrêter et plante mon fichier.
Voici mon code (onglet "Find a price") :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Let's calculate these prices :)
'But first, let's go for some explanations of my code :
'*** Named cells ***
'
'I named all of the user cells to allow me to use the name in my vba code.
'Okay but why?
'=> because if I decide to change the design of my user form sheet, I wouldn't have to update the cells adress in my code
'Indeed if I use named cells, I can change their adress without have to update the code!
'
'All the cells in the sheet "find a price" are like "fp_XXX"
'All the cells in the sheet "Make a quote" are like "mq_XXX"
'All the cells in the sheet "Source data" are like "sd_XXX"
'
'"c" will always means column and "r" row.
'*** Structure of this code ***
'
'First, I will calculate all the different elements (and potential added value) which constitute the price of the cylinders/keys
'And then, I will finally calculate these prices
'Base price of the cylinder
Dim base_cyl_price As Currency
'Each cylinder has a base price depending on which profile and which cylinder type it is
base_cyl_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_cyl_price"), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_cyl_type"), Worksheets("Src_data").Range("sd_cyl_types"), 0))
'We will add in the final formula the value of the potential extensions and other added values
'Extension price
Dim extension_price As Currency
Dim extension_nbr As Byte
'We will determine how many extensions there are
extension_nbr = Application.VLookup((Worksheets("Find a price").Range("fp_ins_length") & Worksheets("Find a price").Range("fp_out_length")), Worksheets("Extensions").Range("tble_extensions"), 2, False)
'And then get the price of all these potential extensions
If extension_nbr <= 10 Then
extension_price = extension_nbr * Worksheets("Src_data").Range("sd_adval_ext_1")
Else
extension_price = extension_nbr * Worksheets("Src_data").Range("sd_adval_ext_2")
End If
'Base price of the key
Dim base_key_price As Currency
'If the client wants a supplementary key with a cylinder, no matter if the plan is 6 months older or no, in the other cases, we first check this point
If Worksheets("Find a price").Range("fp_key_type") = "Supplementary key with cylinder" Then
base_key_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), 1)
Else
If Worksheets("Find a price").Range("fp_ext_6_yn") = "No" Then
base_key_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Worksheets("Find a price").Range("fp_key_type"), Worksheets("Src_data").Range("sd_key_types"), 0))
Else
base_key_price = Worksheets("Src_data").Range("sd_key_price_6")
End If
End If
'Discount rate
Dim discount_rate As Variant
'We just take the rate input by the user
discount_rate = Worksheets("Find a price").Range("fp_discount_rate")
'Potential added value for the pins
Dim adval_pin As Currency
'We just add the potential added value if the client wants a 6 or 7 pins system
If Worksheets("Find a price").Range("fp_pin") = 6 Then
adval_pin = Worksheets("Src_data").Range("sd_adval_6pins")
Else
If Worksheets("Find a price").Range("fp_pin") = 7 Then
adval_pin = Worksheets("Src_data").Range("sd_adval_7pins")
Else
adval_pin = 0
End If
End If
'Potential added value for the system
Dim adval_system As Currency
'We just add the added value for HS systems or GHS ones
If Worksheets("Find a price").Range("fp_system") = "HS" Then
adval_system = Worksheets("Src_data").Range("sd_adval_HS")
Else
If Worksheets("Find a price").Range("fp_system") = "GHS" Then
adval_system = Worksheets("Src_data").Range("sd_adval_GHS")
Else
adval_system = 0
End If
End If
'Potential added value if keyplan extension
Dim adval_not_init As Currency
Dim adval_6months As Currency
'We add the FHZ if the client is not the initiator of the keyplan (22% added-value)
If Worksheets("Find a price").Range("fp_ext_init_yn") = "No" Then
adval_not_init = Worksheets("Src_data").Range("sd_adval_not_init")
Else
adval_not_init = 0
End If
'We add the old system added-value of 7.98€ if the keyplan is 6 months old or more
If Worksheets("Find a price").Range("fp_ext_6_yn") = "Yes" Then
adval_6months = Worksheets("Src_data").Range("sd_adval_6months")
Else
adval_6months = 0
End If
'Potential added value for the finishes
Dim adval_finishes As Currency
'To do...
'Potential added value for the knob
Dim adval_knob As Currency
'To do...
'Let's now calculate the price of the cylinder :)
Dim cylinder_price As Currency
'This is the final formula to calculate the cylinder price, we will just sum up all the things we previously calculated above ;)
cylinder_price = (base_cyl_price + extension_price + adval_pin + adval_system + adval_6months) * (1 + adval_not_init) * (1 - discount_rate)
Worksheets("Find a price").Range("fp_cyl_price") = cylinder_price
'And let's now calculate the price of the key :)
Dim key_price As Currency
'And this is the same for the keys (in more easy)
key_price = base_key_price * (1 + adval_not_init) * (1 - discount_rate)
Worksheets("Find a price").Range("fp_key_price") = key_price
End Sub
Ainsi que mon fichier (rien n'est confidentiel) :
Si quelqu'un trouve une solution.. Je prends!
Vip4rk
Bonjour,
Quelques conseils pour faciliter la lecture d'un code, et identifier plus facilement les erreurs :
- Pas de saut de lignes à tout va
- Pas des tartines de commentaires : commenter c'est bien, mais autant aller à l'essentiel
- Eviter d'alourdir le code avec des références à rallonge et répétées : on déclare les feuilles avec des noms courts et compréhensibles, et/ou on utilise
With Objet ... End With
(voir exemple ci dessous)
With Sheets("Nom Feuille")
.Range("A1") = "Bonjour"
.Range("B1") = "C'est plus facile à lire !"
End With
- On groupe toutes les déclarations de variable en début de macro, jamais en cours d'utilisation !
Un fois qu'on y verra plus clair, on pourra s'attaquer au cœur de ton problème...
Bonjour,
utilise application.enableevents=false et true au debut et à la fin de ta macro événementielle.
ta macro s'exécute quand une cellule de ta feuille est modifiée. or tu modifies (enfin je pense), des cellules de ta feuilles dans ta macro, tu rentres donc dans une boucle sans fin, qui fait planter excel.
Bonjour @Pedro22
Je te remercie pour tes remarques constructives.
Il est vrai que j'ai voulu coder "proprement" mais que ce n'était sans pas le cas!
Je vais suivre tes conseils.
Bonjour @h2so4
Effectivement je pense que tu as vu juste...
Je vais essayer tout de suite mais ça semble logique (je m'étonne de ne pas y avoir pensé rrrh).
Merci!
Vip4rk
C'était bien ça @h2so4, merci!
@Pedro22, j'ai commencé à cleaner mon code comme tu me l'a préconisé.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim discount_rate As Variant
Dim base_cyl_price As Currency
Dim extension_nbr As Byte
Dim extension_price As Currency
Dim base_key_price As Currency
Dim adval_pin As Currency
Dim adval_system As Currency
Dim adval_not_init As Currency
Dim adval_6months As Currency
Dim adval_finishes As Currency
Dim adval_knob As Currency
Dim cylinder_price As Currency
Dim key_price As Currency
Application.EnableEvents = False
Application.ScreenUpdating = False
discount_rate = Range("fp_discount_rate")
base_cyl_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_cyl_price"), Application.WorksheetFunction.Match(Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Range("fp_cyl_type"), Worksheets("Src_data").Range("sd_cyl_types"), 0))
extension_nbr = Application.VLookup((Range("fp_ins_length") & Range("fp_out_length")), Worksheets("Extensions").Range("tble_extensions"), 2, False)
If extension_nbr <= 10 Then
extension_price = extension_nbr * Worksheets("Src_data").Range("sd_adval_ext_1")
Else
extension_price = extension_nbr * Worksheets("Src_data").Range("sd_adval_ext_2")
End If
If Range("fp_key_type") = "Supplementary key with cylinder" Then
base_key_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), 1)
Else
If Range("fp_ext_6_yn") = "No" Then
base_key_price = Application.WorksheetFunction.Index(Worksheets("Src_data").Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Range("fp_profile"), Worksheets("Src_data").Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Range("fp_key_type"), Worksheets("Src_data").Range("sd_key_types"), 0))
Else
base_key_price = Worksheets("Src_data").Range("sd_key_price_6")
End If
End If
If Range("fp_pin") = 6 Then
adval_pin = Worksheets("Src_data").Range("sd_adval_6pins")
Else
If Range("fp_pin") = 7 Then
adval_pin = Worksheets("Src_data").Range("sd_adval_7pins")
Else
adval_pin = 0
End If
End If
If Range("fp_system") = "HS" Then
adval_system = Worksheets("Src_data").Range("sd_adval_HS")
Else
If Range("fp_system") = "GHS" Then
adval_system = Worksheets("Src_data").Range("sd_adval_GHS")
Else
adval_system = 0
End If
End If
If Range("fp_ext_init_yn") = "No" Then
adval_not_init = Worksheets("Src_data").Range("sd_adval_not_init")
Else
adval_not_init = 0
End If
If Range("fp_ext_6_yn") = "Yes" Then
adval_6months = Worksheets("Src_data").Range("sd_adval_6months")
Else
adval_6months = 0
End If
cylinder_price = (base_cyl_price + extension_price + adval_pin + adval_system + adval_6months) * (1 + adval_not_init) * (1 - discount_rate)
Range("fp_cyl_price") = cylinder_price
key_price = base_key_price * (1 + adval_not_init) * (1 - discount_rate)
Range("fp_key_price") = key_price
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Vip4rk
ça évolue dans le bon sens !
J'ai repris ton code pour modifier certains éléments (à tester) :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim discount_rate As Variant
Dim base_cyl_price As Currency, extension_price As Currency, base_key_price As Currency, adval_pin As Currency, adval_system As Currency, adval_not_init As Currency, adval_6months As Currency
Dim adval_finishes As Currency, adval_knob As Currency, cylinder_price As Currency, key_price As Currency
Dim extension_nbr As Byte
Application.EnableEvents = False
Application.ScreenUpdating = False
With Worksheets("Src_data")
discount_rate = Range("fp_discount_rate")
base_cyl_price = Application.WorksheetFunction.Index(.Range("tbl_base_cyl_price"), Application.WorksheetFunction.Match(Range("fp_profile"), .Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Range("fp_cyl_type"), .Range("sd_cyl_types"), 0))
extension_nbr = Application.VLookup((Range("fp_ins_length") & Range("fp_out_length")), Worksheets("Extensions").Range("tble_extensions"), 2, False)
If extension_nbr <= 10 Then extension_price = extension_nbr * .Range("sd_adval_ext_1") Else extension_price = extension_nbr * .Range("sd_adval_ext_2")
If Range("fp_key_type") = "Supplementary key with cylinder" Then
base_key_price = Application.WorksheetFunction.Index(.Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Range("fp_profile"), .Range("sd_profiles"), 0), 1)
Else
If Range("fp_ext_6_yn") = "No" Then
base_key_price = Application.WorksheetFunction.Index(.Range("tbl_base_key_price"), Application.WorksheetFunction.Match(Range("fp_profile"), .Range("sd_profiles"), 0), Application.WorksheetFunction.Match(Range("fp_key_type"), .Range("sd_key_types"), 0))
Else: base_key_price = .Range("sd_key_price_6")
End If
End If
If Range("fp_pin") = 6 Then
adval_pin = .Range("sd_adval_6pins")
Else
If Range("fp_pin") = 7 Then adval_pin = .Range("sd_adval_7pins") Else adval_pin = 0
End If
If Range("fp_system") = "HS" Then
adval_system = .Range("sd_adval_HS")
Else
If Range("fp_system") = "GHS" Then adval_system = .Range("sd_adval_GHS") Else adval_system = 0
End If
If Range("fp_ext_init_yn") = "No" Then adval_not_init = .Range("sd_adval_not_init") Else adval_not_init = 0
If Range("fp_ext_6_yn") = "Yes" Then adval_6months = .Range("sd_adval_6months") Else adval_6months = 0
cylinder_price = (base_cyl_price + extension_price + adval_pin + adval_system + adval_6months) * (1 + adval_not_init) * (1 - discount_rate)
Range("fp_cyl_price") = cylinder_price
key_price = base_key_price * (1 + adval_not_init) * (1 - discount_rate)
Range("fp_key_price") = key_price
End With
Application.EnableEvents = True
End Sub
@Pedro22, super cette fonction With!
Ca marche parfaitement
Merci!
Vip4rk