Autres [RÉSOLU] Serait-il possible mais je ne crois pas...

[un internaute]

Bonjour le forum
Il des années même beaucoup d'années quelqu'un du forum m'avait trouvé cette formule ;;;@*-> pour faire butter automatiquement les pointillés sur cellule adjacente (B1) même si on agrandi la colonne A
Je voudrais faire la même chose sur colonne A cellule A5 mais mettre en couleur 1er Trimestre et là ce n'est pas possible je crois. (il faut plusieurs colonnes et taper le signe - dans la colonne adjacente (B) sinon taper les pointillés au "pif" et le signe >

Merci pour vos éventuels retours
Classeur 1 modifié avec tirait - celulle B5

 

[job75]

Bonjour un internaute,

Voyez le fichier joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim txt$, W#, n%
txt = "Montant Fonds Travaux 1er Trimestre"
Set Target = [A5]
W = Target.ColumnWidth
Application.ScreenUpdating = False
Application.EnableEvents = False
Do
    n = n + 1
    Target = txt & String(n, "-") & ">"
    Target.Columns.AutoFit
Loop While Target.ColumnWidth < W + 1
Target.ColumnWidth = W
Target.Characters(Len(txt) - 12, 13).Font.Color = vbRed
Application.EnableEvents = True
End Sub

Quand on modifie ou valide une cellule quelconque, le nombre de tirets en A5 s'ajuste à la largeur de la cellule.

A+

 

[un internaute]

Bonjour un internaute,

Voyez le fichier joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim txt$, W#, n%
txt = "Montant Fonds Travaux 1er Trimestre"
Set Target = [A5]
W = Target.ColumnWidth
Application.ScreenUpdating = False
Application.EnableEvents = False
Do
    n = n + 1
    Target = txt & String(n, "-") & ">"
    Target.Columns.AutoFit
Loop While Target.ColumnWidth < W + 1
Target.ColumnWidth = W
Target.Characters(Len(txt) - 12, 13).Font.Color = vbRed
Application.EnableEvents = True
End Sub

Quand on modifie ou valide une cellule quelconque, le nombre de tirets en A5 s'ajuste à la largeur de la cellule.

A+

Bonjour job75
Super merci
Un petit truc
Comment je mets un espace après le e de trimestre et le pointillés-->dans la macro?

 

[job75]

Il suffit de mettre l'espace à la fin du texte txt :

txt = "Montant Fonds Travaux 1er Trimestre "

et mettre :

Target.Characters(Len(txt) - 13, 13).Font.Color = vbRed

 

[un internaute]

Si j’agrandis la conne A les pointillées ne suivent pas automatiquement?

 

[job75]

C'est normal, la modification des dimensions ou formats d'une cellule ne crée aucun évènement.

Il faut donc faire comme j'ai indiqué, valider ou modifier...

 

[job75]

Pour mettre à jour le plus simple est de laisser la cellule vide C6 sélectionnée et d'appuyer sur la touche Suppr.

 

[un internaute]

Re job75
Super mais je vais continuer à t'ennuyer!!!
J'ai mis dans le fichier les 4 macros qui faut adapter
1er Trimestre D18
2ème Trimestre D37
3ème Trimestre D56
4ème Trimestre D75
Modifier la macros certainement
Merci à toi

 

[job75]

Dans une feuille on ne peut créer qu'une seule macro Worksheet_Change :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, trim%, txt$, W#, n%
Set plage = Range("D18,D37,D56,D75")
Application.ScreenUpdating = False
Application.EnableEvents = False
For trim = 1 To 4
    txt = "Montant Fonds Travaux " & trim & IIf(trim = 1, "er", "ème") & " Trimestre "
    Set Target = plage.Areas(trim)
    W = Target.ColumnWidth
    n = 0
    Do
        n = n + 1
        Target = txt & String(n, "-") & ">"
        Target.Columns.AutoFit
    Loop While Target.ColumnWidth < W + 1
    Target.ColumnWidth = W
    Target.Characters(Len(txt) - 14, 14).Font.Color = vbRed
Next trim
Application.EnableEvents = True
End Sub

 

[un internaute]

Dans une feuille on ne peut créer qu'une seule macro Worksheet_Change :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, trim%, txt$, W#, n%
Set plage = Range("D18,D37,D56,D75")
Application.ScreenUpdating = False
Application.EnableEvents = False
For trim = 1 To 4
    txt = "Montant Fonds Travaux " & trim & IIf(trim = 1, "er", "ème") & " Trimestre "
    Set Target = plage.Areas(trim)
    W = Target.ColumnWidth
    n = 0
    Do
        n = n + 1
        Target = txt & String(n, "-") & ">"
        Target.Columns.AutoFit
    Loop While Target.ColumnWidth < W + 1
    Target.ColumnWidth = W
    Target.Characters(Len(txt) - 14, 14).Font.Color = vbRed
Next trim
Application.EnableEvents = True
End Sub

Bonjour job75
Chapeau l'artiste
SUPER ÇA FONCTIONNE NICKEL
UN GRAND MERCI
Cordialement
Bonne journée