Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
[file name=test_20050403195118.zip size=43963]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20050403195118.zip[/file]
 

Pièces jointes

  • test_20050403195118.zip
    42.9 KB · Affichages: 16

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
 

pierrot

XLDnaute Junior
bonsoir à tous,
j'ai enfin réussi à mettre en application la formule de RAI,merci à tous
désolé si je vous ai ennuyé avec ce fil


bonne semaine à tous et merci encore pour votre aide

pierrot
 

Discussions similaires

Réponses
1
Affichages
249
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…