Option Explicit
Private Sub Worksheet_Change(ByVal c As Range)
Dim plage As Range
Set plage = Range("B:B,D:D,F:F,G:G")
If c.Count > 1 Then Exit Sub
If Not Intersect(c, plage) Is Nothing Then
Select Case c
Case Is <> "": c.Interior.ColorIndex = 4: Case Else: c.Interior.ColorIndex = xlNone
End Select
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
With Target
If .Column = 2 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 241.5
.Comment.Shape.Height = 99.75
End If
SendKeys "%im"
End If
If .Column = 3 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 241.5
.Comment.Shape.Height = 99.75
End If
SendKeys "%im"
End If
If .Column = 4 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 241.5
.Comment.Shape.Height = 99.75
End If
SendKeys "%im"
End If
If .Column = 5 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 241.5
.Comment.Shape.Height = 99.75
End If
SendKeys "%im"
End If
If .Column = 6 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 241.5
.Comment.Shape.Height = 99.75
End If
SendKeys "%im"
End If
If .Column = 7 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 241.5
.Comment.Shape.Height = 99.75
End If
SendKeys "%im"
End If
If .Column = 8 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 241.5
.Comment.Shape.Height = 99.75
End If
SendKeys "%im"
End If
If .Column = 9 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 241.5
.Comment.Shape.Height = 99.75
End If
SendKeys "%im"
End If
End With
With Target
If .Column = 4 Then
Cancel = True
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 279.5
.Comment.Shape.Height = 130.75
End If
SendKeys "%im"
End If
End With
End Sub
... j'ai déjà ce code dans la page, je veux l'agréger, et fatalement il y a une erreur...
Private Sub Worksheet_Change(ByVal c As Range)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Que donnerait celui-ci ?... j'ai déjà ce code...
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
With Target
If .Column > 1 And .Column < 10 Then
If .Comment Is Nothing Then
.AddComment
.Comment.Shape.Width = 241.5
.Comment.Shape.Height = 99.75
SendKeys "%im"
End If
End If
End With
Application.SendKeys "{NUMLOCK}", True ' clavier numérique activer
End Sub