bonjour à tous,
je voudrai dans une feuille de calcul excel aplliquer 2 formules VBA
la première:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo GESTERR
If Application.Intersect(Target, Range('Calendrier')) Is Nothing Then Exit Sub
Select Case Target.Value
Case 'conges': Selection.Interior.ColorIndex = 11
Selection.Font.ColorIndex = 12
Case 'absent': Selection.Interior.ColorIndex = 13
Selection.Font.ColorIndex = 12
Case 'installation': Selection.Interior.ColorIndex = 8
Selection.Font.ColorIndex = 8
Case 'maladie': Selection.Interior.ColorIndex = 6
Selection.Font.ColorIndex = 12
Case 'atelier': Selection.Interior.ColorIndex = 5
Selection.Font.ColorIndex = 5
Case 'depannage': Selection.Interior.ColorIndex = 24
Selection.Font.ColorIndex = 24
Case Else: Selection.Interior.ColorIndex = xlNone
End Select
If Selection.Cells.Count > 1 Then Selection.Value = Target.Value
Exit Sub
GESTERR:
End Sub
et la deuxième:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
If Not Application.Intersect(Target, Range('Choix')) Is Nothing Then
For Each C In Range('Liste')
If Target.Value = C.Value Then
If Target.Hyperlinks.Count = 0 Then
Target.Hyperlinks.Add Target, C.Hyperlinks(1).Address
Target.Hyperlinks(1).SubAddress = C.Hyperlinks(1).SubAddress
Else
Target.Hyperlinks(1).Address = C.Hyperlinks(1).Address
Target.Hyperlinks(1).SubAddress = C.Hyperlinks(1).SubAddress
End If
Exit Sub
End If
Next C
End If
End Sub
je les écris donc l'une à la suite de l'autre et cela ne fonctionne pas
dois écrire Private Sub Worksheet_Change(ByVal Target As Range)
pour la deuxième formule ?
passez une belle journée
pierrot
je voudrai dans une feuille de calcul excel aplliquer 2 formules VBA
la première:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo GESTERR
If Application.Intersect(Target, Range('Calendrier')) Is Nothing Then Exit Sub
Select Case Target.Value
Case 'conges': Selection.Interior.ColorIndex = 11
Selection.Font.ColorIndex = 12
Case 'absent': Selection.Interior.ColorIndex = 13
Selection.Font.ColorIndex = 12
Case 'installation': Selection.Interior.ColorIndex = 8
Selection.Font.ColorIndex = 8
Case 'maladie': Selection.Interior.ColorIndex = 6
Selection.Font.ColorIndex = 12
Case 'atelier': Selection.Interior.ColorIndex = 5
Selection.Font.ColorIndex = 5
Case 'depannage': Selection.Interior.ColorIndex = 24
Selection.Font.ColorIndex = 24
Case Else: Selection.Interior.ColorIndex = xlNone
End Select
If Selection.Cells.Count > 1 Then Selection.Value = Target.Value
Exit Sub
GESTERR:
End Sub
et la deuxième:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
If Not Application.Intersect(Target, Range('Choix')) Is Nothing Then
For Each C In Range('Liste')
If Target.Value = C.Value Then
If Target.Hyperlinks.Count = 0 Then
Target.Hyperlinks.Add Target, C.Hyperlinks(1).Address
Target.Hyperlinks(1).SubAddress = C.Hyperlinks(1).SubAddress
Else
Target.Hyperlinks(1).Address = C.Hyperlinks(1).Address
Target.Hyperlinks(1).SubAddress = C.Hyperlinks(1).SubAddress
End If
Exit Sub
End If
Next C
End If
End Sub
je les écris donc l'une à la suite de l'autre et cela ne fonctionne pas
dois écrire Private Sub Worksheet_Change(ByVal Target As Range)
pour la deuxième formule ?
passez une belle journée
pierrot