Claudy
XLDnaute Accro
Bonjour, dans un classeur, j'ai la procédure ci dessous...
elle fonctionne bien, MAIS, sur n'importe quelle feuille de mon classeur, si je "delete" plusieurs cellules, ou je tire vers le bas, j'ai mon inputbox "Combien de litres d'essence?" qui s'ouvre.
J’ai essayé de désactiver en plaçant des ' devant les if....et la suite jusque end if, mais alors c'est l'autre inputbox qui appert(InputBox("Quel achat?", , )
Merci d'avance pour votre aide,
Claudy
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Dim madate
madate = Format(Date, "mm/dd/yyyy ")
c = Target.Row
If Target.Column = 7 Then
'Cells(c, 8) = Cells(c, 7).Value * 40.3399
Cells(c, 10) = madate
If Target.Value < 0 Then
Target.ClearComments
Target.AddComment
Target.Comment.Text Text:="Recette exeptionnelle!!!"
Target.Comment.Shape.OLEFormat.Object.Font.Size = 14 ' taille texte
Target.Comment.Shape.TextFrame.AutoSize = True 'ajuste taille auto
Target.Comment.Shape.OLEFormat.Object.Font.Bold = True 'met en gras le texte
End If
Cells(c, 9).Select
End If
If Target.Value Like "*essence*" Then
prix = Target.Offset(0, -2).Value
litre = InputBox("Combien de litres d'essence?", , , 8000, 10000)
prixlitre = Format(prix / litre, "#.##0,00")
Target.ClearComments
Target.AddComment
Target.Comment.Text Text:="Replein le " & Date & " : " & litre & " litres d'essence à " & prixlitre & " Euros/litre."
Target.Comment.Shape.OLEFormat.Object.Font.Size = 14 ' taille texte
Target.Comment.Shape.TextFrame.AutoSize = True 'ajuste taille auto
Target.Comment.Shape.OLEFormat.Object.Font.Bold = True 'met en gras le texte
End If
If Target.Value Like "*déma*" Then
achat = InputBox("Quel achat?", , "Pellets", 8000, 10000)
prix = Target.Offset(0, -2).Value
derlig = Worksheets("Brico Déma").Range("A10000").End(xlUp).Row + 1
Worksheets("Brico Déma").Range("A" & derlig) = Date
Worksheets("Brico Déma").Range("B" & derlig) = prix
Worksheets("Brico Déma").Range("C" & derlig) = prix / 10
Worksheets("Brico Déma").Range("D" & derlig) = achat
End If
If Target.Column = 9 Then
Cells(c + 1, 7).Select
End If
'For Each Sh In ActiveWorkbook.Worksheets
'If Range("D2").Value < 0 Then
' Sh.Tab.ColorIndex = 5
'End If
'Next
'If Not (Sheets("économies").Activate) Then
If Target.Column = 2 Then
Cells(c, 4).Select
End If
'End If
End Sub
elle fonctionne bien, MAIS, sur n'importe quelle feuille de mon classeur, si je "delete" plusieurs cellules, ou je tire vers le bas, j'ai mon inputbox "Combien de litres d'essence?" qui s'ouvre.
J’ai essayé de désactiver en plaçant des ' devant les if....et la suite jusque end if, mais alors c'est l'autre inputbox qui appert(InputBox("Quel achat?", , )
Merci d'avance pour votre aide,
Claudy
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Dim madate
madate = Format(Date, "mm/dd/yyyy ")
c = Target.Row
If Target.Column = 7 Then
'Cells(c, 8) = Cells(c, 7).Value * 40.3399
Cells(c, 10) = madate
If Target.Value < 0 Then
Target.ClearComments
Target.AddComment
Target.Comment.Text Text:="Recette exeptionnelle!!!"
Target.Comment.Shape.OLEFormat.Object.Font.Size = 14 ' taille texte
Target.Comment.Shape.TextFrame.AutoSize = True 'ajuste taille auto
Target.Comment.Shape.OLEFormat.Object.Font.Bold = True 'met en gras le texte
End If
Cells(c, 9).Select
End If
If Target.Value Like "*essence*" Then
prix = Target.Offset(0, -2).Value
litre = InputBox("Combien de litres d'essence?", , , 8000, 10000)
prixlitre = Format(prix / litre, "#.##0,00")
Target.ClearComments
Target.AddComment
Target.Comment.Text Text:="Replein le " & Date & " : " & litre & " litres d'essence à " & prixlitre & " Euros/litre."
Target.Comment.Shape.OLEFormat.Object.Font.Size = 14 ' taille texte
Target.Comment.Shape.TextFrame.AutoSize = True 'ajuste taille auto
Target.Comment.Shape.OLEFormat.Object.Font.Bold = True 'met en gras le texte
End If
If Target.Value Like "*déma*" Then
achat = InputBox("Quel achat?", , "Pellets", 8000, 10000)
prix = Target.Offset(0, -2).Value
derlig = Worksheets("Brico Déma").Range("A10000").End(xlUp).Row + 1
Worksheets("Brico Déma").Range("A" & derlig) = Date
Worksheets("Brico Déma").Range("B" & derlig) = prix
Worksheets("Brico Déma").Range("C" & derlig) = prix / 10
Worksheets("Brico Déma").Range("D" & derlig) = achat
End If
If Target.Column = 9 Then
Cells(c + 1, 7).Select
End If
'For Each Sh In ActiveWorkbook.Worksheets
'If Range("D2").Value < 0 Then
' Sh.Tab.ColorIndex = 5
'End If
'Next
'If Not (Sheets("économies").Activate) Then
If Target.Column = 2 Then
Cells(c, 4).Select
End If
'End If
End Sub