XL 2013 Fonction gras

[Jouxte]

Bonjour à toutes et tous,

Je n'ai pas réussi à trouver ni dans ce forum, ni sur Internet une fonction VBA qui permette de mettre en gras.
Je me suis essayé à écrire

Function Gras(texte As String)

texte.Font.Bold = True


End Function

Mais ça ne fonctionne pas.
Help !! merci d'avance

 

[job75]

Bonjour Jouxte,

Une fonction ne peut pas le faire, il faut une procédure Sub :

Sub Test()
Gras [A1:A10]
End Sub

Sub Gras(r As Range)
 r.Font.Bold = True
End Sub

A+

 

[Dranreb]

Pourquoi une Function ?
Par ailleurs un String n'est pas un objet, il n'a donc aucune propriété, ni Font ni autre.
Une Sub pour un Range :

Sub Gras(ByVal Rng As Range)
   Rng.Font.Bold = True
   End Sub
Sub Test()
   Cells(1, "A").Value = "Un texte"
   Gras Cells(1, "A")
   End Sub

 

[Jouxte]

Merci pour vos réponses.
Pourquoi une fonction ?
Car je souhaite avoir une formule du genre
="texte "&gras(A2)&A3

 

[sylvanu]

Bonjour Jouxte, Job, Dranreb,
On peut au sein d'une fonction modifier une propriété d'affichage, par exemple :

Function Rouge(Texte As String)
    Range(Application.Caller.Address).Font.Color = vbRed
    Rouge = Texte
End Function

Par contre je n'arrive pas à modifier Gras, Italique ou Souligné.
La fonction suivante ne fait rien :

Function Gras(Texte As String)
    Range(Application.Caller.Address).Font.Bold = True
    Gras = Texte
End Function

Mystère !

 

[Jouxte]

Merci sylvanu.
Faute de grive, on mange des merles.
Je mettrai le texte en couleur et non pas en gras sauf si une nouvelle solution voyait le jour.

 

[Jouxte]

Avec la fonction rouge, l'ensemble de la cellule se retrouve en rouge et non pas une partie seulement du texte.

 

[sylvanu]

Re,
Par contre, cela ne marchera pas avec votre formule "="texte "&gras(A2)&A3" car c'est la cellule qui est mise en rouge et non la valeur A2.

 

[Dranreb]

Par contre je n'arrive pas à modifier Gras, Italique ou Souligné.

Sur de plus anciennes versions il me semble qu'on ne pouvait rien modifier dans une Function, pas même Application.Caller.Font.Color. Une Function renvoyait une valeur un point c'est tout, Excel boycottait toute invocation de ses méthodes et propriétés pendant les calculs. J'en ai gardé l'habitude de ranger dans une Collection VBA une consigne qui est appliquée après les calculs dans une Worksheet_Calculate ou une Workbook_SheetCalculate.
Je pense qu'il serait possible sur ce principe d'écrire une Function ConcatAlternGras qui concatènerait tous les paramètres en alternant normal et gras.

Édition: mais non, suis-je bête ! C'est infaisable: On ne peut mettre en gras que des parties de cellule constante, pas renvoyée par une formule !

 

[job75]

Bonjour Jouxte, Bernard, sylvanu, le forum,

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

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2]) Is Nothing Then Exit Sub
Dim x$, L%, r As Range, i%
x = LCase([C2]): L = Len(x)
Application.ScreenUpdating = False
Set r = Range("A2", Range("A" & Rows.Count).End(xlUp))
If r.Row = 1 Then Exit Sub
r.Font.Bold = False: r.Font.Italic = False 'RAZ
If x = "" Then Exit Sub
For Each r In r
    For i = 1 To Len(r) - L + 1
        If LCase(Mid(r, i, L)) = x Then
            With r.Characters(i, L).Font
                .Bold = True 'gras
                .Italic = True 'italique
            End With
        End If
Next i, r
End Sub

Testée sur 100 000 lignes => 40 secondes pour bonjour, 17 secondes pour les autres critères.

A+

 

[Jouxte]

Bonjour Job75,
Merci pour cette belle macro.
Je vous joint un fichier de ce que j'aurais souhaité faire (en cellule D2) avec le format en cellule D3.
Le fichier contient environ 1000 lignes.Est-ce possible par macro ?
Par avance merci.

 

[job75]

Bonjour Jouxte, le forum,

Le fichier en retour avec cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, i&, L%
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With Range("D1:I" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    tablo = .Value
    For i = 2 To UBound(tablo)
        tablo(i, 1) = Trim(tablo(i, 2) & " " & tablo(i, 3) & vbLf & Format(tablo(i, 4), "dd mmm yyyy") & vbLf & Format(tablo(i, 5), "0000000000") & vbLf & tablo(i, 6))
        If tablo(i, 1) = vbLf & vbLf & vbLf Then tablo(i, 1) = ""
    Next
    .Offset(1).Font.Bold = False 'RAZ
    .Value = tablo 'restitution
    For i = 2 To UBound(tablo)
        L = Len(LTrim(tablo(i, 2)))
        If L Then .Cells(i, 1).Characters(1, L).Font.Bold = True
        L = Len(RTrim(tablo(i, 6)))
        If L Then .Cells(i, 1).Characters(Len(tablo(i, 1)) - L + 1, L).Font.Bold = True
    Next
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Sur 1000 lignes elle s'exécute chez moi en 0,6 seconde.

A+

 

[Jouxte]

Bonjour Job75, bonjour à toutes et tous,

Merci pour cette macro qui convient parfaitement à ce que je souhaitais faire.

 

[job75]

La macro n'était pas parfaite, j'ai rajouté .Offset(1).Font.Bold = False 'RAZ

 

[Jouxte]

J'ai fait la remise en "maigre" manuelle. Pour le reste c'est top.