appliquer 2 formules VBA dans une feuille

pierrot

XLDnaute Junior
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
;)
 

Rai

XLDnaute Junior
Bonjour,

On ne peut pas déclarer 2 evennements identiques pour le même objet.

J'ai jeté un peil sur tes procs, et en les réunissant ça devrait donner quelquechose du genre (à tester sur tes données) :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo GESTERR

Dim C As Range

If Not (Application.Intersect(Target, Range('Calendrier')) Is Nothing) Then
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
End If

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

GESTERR:
End Sub


A adapter à tes besoins.

Bon Dimanche
 

pierrot

XLDnaute Junior
bonsoir à tout le forum et mercci RAI de ton aide mais je n'arrive vraiment pas à mettre en apllication ta formule.
j'ai essayé de joindre un exemple clair de mon problème qui est donc le suivant
dans un classeur excel j'ai un code VBA qui me sert à colorer des cellules je voudrai ajouter un autre code pour une autre fonction(avoir accès à des liens hypertexte dans une zone de liste)
mais je n'arrive pas à les écrire ensemble pour qu'elle fonctionne chacune dans la même feuille

bonne soirée à tous ;)

pierrot
 

pierrot

XLDnaute Junior
bonjour à tout le forum,

et oui encore pierrot , j'ai beau faire tout ce que je peux,impossible d'écrire mes deux codes VBA.
récapitulons:
j'ai un code VBA pour colorer des cellules dans un tableau excel,j'en ai une deuxième dans un autre classeur m'ajoutant une autre fonction qui n'a rien à voir avec la première.(que je voudrai rajouter dans le classeur ou j'ai mon code pour colorer)
je n'arrive vraiment pas à trouver la syntaxe pour les écrire ensemble,j'ai toujours un message d'erreur

merci à tous

pierrot
;)
 

Discussions similaires

Réponses
1
Affichages
242

Statistiques des forums

Discussions
312 191
Messages
2 086 051
Membres
103 108
dernier inscrit
Captain NRJ