Re : Macro marche pas avec des nombres pas arrondi
ça plante apres qu'il est ouvert le fichier base prix. il renvoie l'erreur "erreur d'exécution 13" (incompatibilité de type).
Ci-dessous la macro complète:
Sub Bouton1_QuandClic()
Dim fichier As String, Formule As String, PrixArticle As Double, NbArticle As Double
Dim DerL As Long, L As Long, C As Integer, DerC As Integer
'enlever ' aux 2 lignes suivantes pour choisir dossier, puis fichier
filtre = "Fichiers Excel(*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm)"
fichier = Application.GetOpenFilename(filtre, 1, "Sélection de la base des prix")
'à commenter si les 2 précédentes ne le sont pas
Workbooks.Open Filename:=fichier
TblPrix = ActiveWorkbook.ActiveSheet.UsedRange
ActiveWorkbook.Close False
Application.ScreenUpdating = False
Application.EnableEvents = False
Formule = "="
With Worksheets("bd")
DerL = .Range("A65536").End(xlUp).Row
'pour formules en N changer value par formula
.Range("N2:N" & DerL).Value = .Range("M2:M" & DerL).Value
.Range("M2:M" & DerL).ClearContents
For L = 2 To DerL
If .Cells(L, 4) <> "" Then
nbcol = Application.CountA(.Range("D" & L & ":J" & L)) 'colonnes D à J
Select Case nbcol
Case 1
PrixArticle = CherchePrix(.Cells(L, 4)) 'colonne D
If PrixArticle > 0 Then
If InStr(CStr(PrixArticle), ",") > 0 Then
PrixArticle = Replace(CStr(PrixArticle), ",", ".")
End If
.Cells(L, 13).Formula = "=" & PrixArticle
.Cells(L, 4).Interior.ColorIndex = 45
Else
.Cells(2, 4).Interior.ColorIndex = 44
End If
Case Is > 1
For C = 4 To nbcol + 3
If C > 4 Then
d = InStr(.Cells(L, C), "[") + 1
f = InStr(.Cells(L, C), "x")
NbArticle = Mid(.Cells(L, C), d, f - d)
codearticle = Mid(.Cells(L, C), InStr(.Cells(L, C), " ") + 1)
Else
codearticle = .Cells(L, 4)
End If
PrixArticle = CherchePrix(codearticle)
If PrixArticle > 0 Then
If InStr(CStr(PrixArticle), ",") > 0 Then
PrixArticle = Replace(CStr(PrixArticle), ",", ".")
End If
If C > 4 Then
Formule = Formule & "+(" & NbArticle & "*" & PrixArticle & ")"
Else
Formule = "=" & PrixArticle
End If
.Cells(L, C).Interior.ColorIndex = 45
Else
.Cells(L, C).Interior.ColorIndex = 44
End If
Next
.Cells(L, 13).Formula = Formule
End Select
End If
Next
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
