Résolu Autres VBA - privatesub avec "this workbook" sur wks.name commence par "C"

zebanx

XLDnaute Accro
Bonjour à tous,

Le petit code suivant me permet d'arriver au bon affichage (partie de la cellule avant "*" sur un range à mettre en vert et en gras) sur la feuille "critère" après chaque saisie sur une plage définie.
Le code est enregistré dans la feuille "critère".

Souhait : que cette private sub fonctionne à la saisie sur toutes les feuilles dont le nom commence par un "C".
Le nombre de feuilles commencant par un "C" sera variable.

Le code a été repris dans "this workbook" mais sa modification est incorrecte pour obtenir le résultat souhaité.
Pourriez-vous s'il vous plait m'indiquer comment y parvenir ?

Vous en remerciant, bonne soirée
zebanx

VB:
Private Sub Worksheet_Change(ByVal sh As Object, ByVal c As Range)
sh = ActiveSheet.Name
If Left(sh, 1) = "C" Then
    Set plage = Range("A1:G16")
    If Not Application.Intersect(c, plage) Is Nothing Then
    On Error Resume Next
    s = Split(c, "*")
        If IsError(s(1)) = True Then
        c.Font.Bold = False
        c.Font.Color = RGB(0, 0, 0)
        Else
        c.Characters(1, Len(s(0))).Font.Bold = True
        c.Characters(1, Len(s(0))).Font.Color = RGB(30, 140, 0) '--vert
        End If
    End If
End If
End Sub
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

ChTi160

XLDnaute Barbatruc
Bonsoir zebanx
Peut être dans l'évènement :
VB:
 Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
pas sur d'avoir compris Lol
jean marie
 

eriiiic

XLDnaute Barbatruc
Bonjour à tous,

Set plage = Range("A1:G16")
comme tu travailles avec sh il faut lui dire sinon c'est la feuille active :
VB:
Set plage = sh.Range("A1:G16")
eric

edit : remarque avec un Change elle aurait du mal à ne pas être active :)
Je regarde le fichier
 

ChTi160

XLDnaute Barbatruc
re
Bonsoir eric
ceci semble fonctionner !
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name Like "C*" Then
    Set plage = Sh.Range("A1:G16")
    If Not Application.Intersect(Target, plage) Is Nothing Then
    On Error Resume Next
    s = Split(Target, "*")
        If IsError(s(1)) = True Then
        Target.Font.Bold = False
        Target.Font.Color = RGB(0, 0, 0)
             Else
        Target.Characters(1, Len(s(0))).Font.Bold = True
        Target.Characters(1, Len(s(0))).Font.Color = RGB(30, 140, 0) '--vert
        End If
    End If
End If
End Sub
jean marie
 
Ce message a été identifié comme étant une solution!

zebanx

XLDnaute Accro
Bonsoir Chti60, Eriiic

@Chti60
Super, fonctionne parfaitement.:)

@Eriiic
Bonne remarque.

Très sympa d'avoir regardé cela si rapidement.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas