Remplacer texte par un autre à l'activation sans perte de mise en forme

Bonjour à tous,

Contexte :
Je cherche à modifier un texte par un autre à chaque fois qu'une des feuilles (n'importe laquelle) de mon classeur est activée.
En effet quand j'ouvre mon fichier le matin il y a plusieurs feuilles qui contiennent plusieurs cellules avec du texte mis en forme dont 2 textes sont à personnaliser : "AAAA/MM/JJ" que je dois remplacer par "2022/05/12" (par exemple) et "HH:MM" que je dois remplacer par "11:35" (par exemple).

Je souhaiterai programmer en Private Sub Workbook_SheetActivate => qu'à chaque fois que j'active une feuille (n'importe laquelle du classeur), ça remplace tous les
"AAAA/MM/JJ" par la date du jour, et tous les "HH:MM" par l'heure actuelle. Cela m'éviterait de les modifier manuellement tous les jours et x fois par jour pour les heures.

L'un d'entre vous saurait-il comment programmer une Private Sub Workbook_SheetActivate qui met à jour tout seule un texte A trouvé par un texte B connu, et tout ça sans perdre la mise en forme de la cellule existant qui contient certaines partie du texte en gras et en couleur.

En PJ de cette discussion mon fichier avec 2 exemples de feuilles qui contiennent des textes à modifier => tous les textes en rouges ont besoin d'être mis à jour dès qu'on active une fichier, et sans touché à la mise en forme du reste de la cellule (une fois la date et l'heure mis en rouge elles doivent restées en rouge).

Merci d'avance pour votre aide et bonne journée à vous,

4mon-fichier.xlsm (101.31 Ko)

Bonjour o.aurelien

Je viens de regarder ta PJ...

Tel que tu as organisé tes onglets [CS] et [ADM], la modification demandée n'est pas réalisable pour 2 raisons principales

  1. Il serait trop long de parcourir tous les messages de chacun des onglets afin de rechercher et modifier les dates et heures
  2. Il est trop difficilement possible de conserver "toute" la mise en forme, étant donné qu'il y beaucoup de mise en couleurs (placées en dur dans la barre d'édition)

Je te suggère donc de découper tes messages en plusieurs colonnes, tel que cela :

  1. Une colonne pour CS, ADM... éventuellement formatée avec une MFC
  2. Une colonne contenant seulement le message "installation non réalisée le" (par exemple)
  3. Une colonne ne contenant que les DATES (à mettre à jour avec Sheet_Activate)
  4. Une colonne ne contenant que l'HEURE (à mettre à jour avec Sheet_Activate)
  5. Une dernière colonne pour les Initiales

Une mise en forme sans doute plus adaptée à la lecture et surtout à la modification automatique que tu envisages !

Autre point non négligeable, à supposer que les "messages" peuvent être répétitifs, il devient possible de mettre en place un filtre pour réduire les listes, filtrer une date ou une période de dates, filtrer selon les initiales, etc.

PS/ J'attire ton attention sur le fait que la modification par Sheet_Activate fonctionnera à chaque activation du classeur, c'est-à-dire que la DATE et l'HEURE seront en permanence mise à jour ! Même si ce problème peut être contourné, il en va ainsi dans le cadre des procédures événementielles !

bonjour le forum

une proposition (à tester)

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Set re = Sh.UsedRange.Find("AAAA/MM/JJ", lookat:=xlPart, LookIn:=xlValues)
    If Not re Is Nothing Then
        fa = re.Address
        Do
            s = InStr(re.Text, "AAAA/MM/JJ")
            If s > 0 Then
                re.Characters(s, 10).Text = Format(Now, "YYYY/MM/DD")
            End If
            s = InStr(re.Text, "HH:MM")
            If s > 0 Then
                re.Characters(s, 5).Text = Format(Now, "HH:MM")
            End If
            Set re = Sh.UsedRange.FindNext(re)
            If re Is Nothing Then Exit Do
        Loop Until re.Address = fa
    End If
End Sub

C’est exactement ce dont j’avais besoin merci beaucoup H2so4 !

Donc code testé tout l'après midi et je confirme ça fonctionne très bien.

Je ne sais s'il est possible d'aller encore plus loin avec ce code. Par exemple à l'ouverture à 14h18 tous mes champs textes "H:MM" se mettent donc bien à jour à "14h18" mais ensuite dans le courant de la journée est-il possible de lui faire faire une mise à jour de ce texte pour qu'il se mette toujours à la bonne heure ?

En résumé :
1(ce qui fonctionne aujourd'hui)-Première ouverture du fichier vierge j'ai plusieurs champs avec la valeur "HH:MM" (et on arrive à tous les remplacer par 14h18 avec le code ci-dessus)
2(ma nouvelle question)-Si à 15h04 j'active à nouveau ma feuille par exemple je souhaiterai que tous les champs (qui sont désormais à 14h18 et non plus "HH:MM") se mettent à jour en 15h04

Merci d'avance pour vos idées.

Bonne soirée

bonjour,

une adaptation du code toutes les dates et heures en rouge sont remplacées à l'activation de la feuille. Comme dans la macro précédente, l'heure n'est remplacée que si il y a une date dans la ligne.

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Dim re As Range
    Set re = sh.UsedRange.Find("/", lookat:=xlPart, LookIn:=xlValues)
    If Not re Is Nothing Then
        fa = re.Address
        Do
            s = searchdate(re)
            If s > 0 Then
                re.Characters(s, 10).Text = Format(Now, "yyyy/mm/dd")
            End If
            s = searchtime(re)
            If s > 0 Then
                re.Characters(s, 5).Text = Format(Now, "hh:mm")
            End If
            Set re = sh.UsedRange.FindNext(re)
            If re Is Nothing Then Exit Do
        Loop Until re.Address = fa
    End If
End Sub
Private Function searchdate(chaine As Range)
    s = searchstring(chaine, "/")
    searchdate = s - 4
End Function
Private Function searchtime(chaine As Range)
    s = searchstring(chaine, ":")
    searchtime = s - 2
End Function
Private Function searchstring(chaine As Range, car, Optional couleur = vbRed)
    s = 1
    trouve = False
    Do Until s = 0
        s = InStr(s, chaine, car)
        If s <> 0 Then
            If chaine.Characters(s, 1).Font.Color = couleur Then Exit Do
            s = s + 1
        End If
    Loop
    searchstring = s
End Function

Bonjour H2so4 et encore merci pour votre aide ça a fonctionné à 99,9999% encore une fois ! :)

Il me reste 2 cas de textes particuliers pour lesquels le code ne fonctionne pas :

1-Dans le cas où j'ai 2 dates dans le même texte, par exemple "ADM-Absence client du 2022/05/13 au AAAA/MM/JJ (vos initiales)" => la 2ème date n'est pas
trouvée dans le même texte et donc ne se met pas à jour

2-Dans certains textes j'ai des "/" sans rapport avec la date dans le texte, par exemple "ADM : Appel reprise/poursuite ? (cf note du AAAA/MM/JJ)" => désormais ça m'affiche "Appel rep2022/05/13uite ? (cf note du AAAA/MM/JJ)"=> la date s'est mise au mauvais endroit et la vraie date n'est pas mise à jour

Sinon pour toutes les autres syntaxes de texte que je peux avoir tout le code fonctionne à merveille et c'est déjà super ! Encore un grand merci pour votre aide :)
Auriez-vous une idée pour contourner les 2 points restants évoqués ci-dessus ?

Merci d'avance et bonne journée à vous,

bonjour,

1-Dans le cas où j'ai 2 dates dans le même texte, par exemple "ADM-Absence client du 2022/05/13 au AAAA/MM/JJ (vos initiales)" => la 2ème date n'est pas

trouvée dans le même texte et donc ne se met pas à jour

dans ce cas faut-il changer les 2 dates ? j'ai une doute. si non comment savoir laquelle des 2 il faut changer ? faut-il changer toutes les dates et toutes les heures quelles que soient leur mise en forme ?

Tout d'abord merci à vous pour votre aide, déjà le script de ce matin fonctionne très bien et il ne reste plus que des exceptions.
Donc je pense qu'il ne faut pas perdre le script de ce matin mais simplement y apporter une modification pour pouvoir gérer les exceptions.

Pour répondre à vos questions :
- Oui dans le cas ou il y aurait 2 date dans la même cellule j'ai besoin que les 2 dates soient mises à jour.
- Oui il faut changer toutes les dates. Mais non il ne faut pas changer toutes les heures, uniquement les heures qui suivent une date (cf. PJ et explications ci-dessous).

Je mets en PJ les 6 cas de figures que j'ai recensés dans

4classeur10.xlsx (9.70 Ko)

les centaines de syntaxes que j'ai, et j'ai indiqué en face de chacune des 6 le comportement attendu.
J'espère que ce sera plus simple pour comprendre et encore merci d'avance :)

re-bonjour;

ma dernière contribution sur le sujet :

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Dim re As Range
    Set re = sh.UsedRange.Find("/", lookat:=xlPart, LookIn:=xlValues)
    If Not re Is Nothing Then
        fa = re.Address
        Do
            sdate = replacedate(re, Format(Now, "yyyy/mm/dd"))
            If sdate > 0 Then replacetime re, Format(Now, "hh:mm"), sdate
            Set re = sh.UsedRange.FindNext(re)
            If re Is Nothing Then Exit Do
        Loop Until re.Address = fa
    End If
End Sub
Private Function replacedate(chaine As Range, newdate)
    s = 1
    sdate = 0
    Do Until s = 0
        s = InStr(s, chaine, "/")
        If s <> 0 Then
            s1 = Mid(chaine, s - 1, 1)
            s2 = Mid(chaine, s + 1, 1)
            If Mid(chaine, s + 3, 1) = "/" And (s1 Like "#" Or s1 = "A") And (s2 Like "#" Or s2 = "M") Then
                chaine.Characters(s - 4, 10).Text = newdate
                If sdate = 0 Then sdate = s - 4
                s = s + 10
            End If
            s = s + 1
        End If
    Loop
    replacedate = sdate
End Function
Private Sub replacetime(chaine As Range, newtime, sdate)
    s = sdate
    Do Until s = 0
        s = InStr(s, chaine, ":")
        If s <> 0 Then
            s1 = Mid(chaine, s - 1, 1)
            s2 = Mid(chaine, s + 1, 1)
            If (s1 Like "#" Or s1 = "H") And (s2 Like "#" Or s2 = "M") Then
                chaine.Characters(s - 2, 5).Text = newtime
                s = s + 5
            End If
            s = s + 1
        End If
    Loop
End Sub

Ça fonctionne super bien !! Un grand merci pour votre contribution d’une efficacité parfaite. Bon week-end à vous

Bonjour,

Je teste le code depuis ce matin et cela semble très bien fonctionner, merci

Etant donné que je reste 90% du temps sur le même onglet, j'ai voulu copier/coller le code principal de la Workbook_SheetActivate dans Workbook_SheetSelectionChange. De cette manière j'espère ne pas avoir à changer d'onglet pour devoir avoir la mise à jour de l'heure. Je pensais que dès que je changerai de cellule sur mon onglet, la Workbook_SheetSelectionChange se déclencherai et la mise à jour de l'heure se ferait. Mais ça ne fonctionne pas j'ai ce message d'erreur (ci-dessous) :

capture d ecran 2022 05 16 120101

En résumé :

Le contenu du code de la Workbook_SheetActivate fonctionne très bien dès que je clique sur un onglet, mais si je veux avoir l'exécution de ce code à chaque fois que je change de cellule en plus de à chaque fois que je change de feuille, il ne semble pas possible de réutiliser ce même code dans les 2 private sub.

N'est-il pas possible d'utiliser un même code dans 2 privates sub ?

Merci pour votre retour d'expérience sur ce sujet.

Bonne journée à vous,

Rechercher des sujets similaires à "remplacer texte activation perte mise forme"