Autres Mettre en gras après ":" Excel 2007

[kkamadou]

Bonour,
J'ai un grand souci
je veux mettre en gras ceci
Sheets("Feuil5").Range("A8").Value = "Date d'adhésion :" & " " & Cell.Offset(0, 1)
Sheets("Feuil5").Range("A8").Characters(Start:=17, Length:=30).Font.Bold = True
le code ci-dessus marche mais je veux un code qui pourra identifier les ":" puis mettre en
gras le texte qui se trouve à droite des ":" c'est-à-dire celui provenant de Cell.Offset(0, 1)
afin de faire une boucle pour mettre en gras tous les textes aprés les ":"
car je suis obligé de recopier autant de fois la seconde ligne de code que la première ligne de code.
merci d'avance

 

[Staple1600]

Bonjour le fil, kkmadaou et ses intervenants

•>kkmadou
Essaies ceci

Sub Boldanizator()
Dim i&
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(3).Row
chrStart = InStr(1, Cells(i, 1).Text, ":")
Cells(i, 1).Characters(chrStart + 1, 99).Font.Bold = True
Next
End Sub

PS: Ne fonctionne que si le : apparaît qu'une seule fois par cellule

 

[Staple1600]

Re

Une version paramétrée du code précédent
(avec en "bonus" le choix de la couleur de ce qui est mis en gras)
(faut bien s'occuper puisque on nous conseille de rester en nos demeures)

Sub testA()
'gras et rouge
Application.ScreenUpdating = False
ChangeFont vbRed
End Sub
Sub testB()
'gras et jaune
Application.ScreenUpdating = False
ChangeFont vbYellow
End Sub
Private Sub ChangeFont(Couleur As XlColorIndex, Optional Sep As String = ":")
Dim i&
For i = 1 To Cells(Rows.Count, 1).End(3).Row
chrStart = InStr(1, Cells(i, 1).Text, Sep)
With Cells(i, 1).Characters(chrStart + 1, 99).Font: .Bold = True: .Color = Couleur: End With
Next
End Sub

 

[kkamadou]

Ça marche seulement quand le texte est dans la colonne A. pourtant j'ai du texte de la colonne A à la colonne G. J'ai fait ceci
Sub Boldanizator()
Dim i&
Dim j&
Dim chrStart As Long
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(3).Row
For j = 1 To 7
chrStart = InStr(1, Cells(i, j).Text, ":")
Cells(i, j).Characters(chrStart + 1, 99).Font.Bold = True
Next
Next
End Sub
1 à 7 pour prendre en compte les de A à G
Mais les cellules vides et celles ne contenant pas de ":" se mettent aussi en gras
ce que je souhaite éviter.

 

[Staple1600]

Re

Tu as le droit de renommer ma macro selon ton goût
Laisse-moi le temps d'"adapter le code initial
Prends un tit café ou une tite bière en patientant.

 

[patricktoulon]

re
Bonjour
ben il me semble evident que le instr donne 0 si vide ou pas de ":" donc toute la cellules est prise en compte
il te faut le mettre dans un "If"

Sub Boldanizator()
    Dim i&, j&, chrStart&, q As Boolean
    Application.ScreenUpdating = False
    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        For j = 1 To 7
            chrStart = InStr(1, Cells(i, j).Text, ":")
            q = chrStart > 0
            If q Then Cells(i, j).Characters(chrStart + 1, 99).Font.Bold = True
        Next
    Next
End Sub

 

[Staple1600]

Re

Test OK sur mon PC

Sub BoldMeUpBeforeI_Go_Go()
Dim plg As Range, c As Range, chrStart&
Set plg = Range("A:J")
For Each c In plg.SpecialCells(xlCellTypeConstants, 2)
chrStart = InStr(1, c.Text, ":")
If chrStart > 0 Then
c.Characters(chrStart + 1, 99).Font.Bold = True
End If
Next
End Sub

EDITION1: Ah je suis repassé trop tard
(Mais moi, j'ai agi, pardon A:J )
(en clair dans le texte, je veux dire )
EDITION2: Je viens de voir que c'était AG
J'étais un peu AG, pardon âgé quand j'ai agi
Vous adapterez en conséquence en remplaçant A:J par A:G

 

[patricktoulon]

re
LOL le non de la sub

Sub test()
    BoldanicolaroitalicofontAnzator 1, 7
End Sub

Sub BoldanicolaroitalicofontAnzator(col1 As Long, col2 As Long)
    Dim i&, j&, chrStart&, q As Boolean
    Application.ScreenUpdating = False
    For i = 1 To Cells(Rows.Count, col1).End(3).Row
        For j = 1 To col2
            chrStart = InStr(1, Cells(i, j).Text, ":")
            q = chrStart > 0
            If q Then
                With Cells(i, j).Characters(chrStart + 1, 99)
                    .Font.FontStyle = "Gras italique"
                    .Font.Color = vbRed
                    .Font.Name = "arial"
                    'etc....
                End With
            End If
        Next
    Next
End Sub

 

[Staple1600]

Re

•>patricktoulon
Pas de RegExp sous le code pour bolder autrement?

 

[patricktoulon]

re
a vrai dire je vois pas trop ce qu'un regex pourrait apporter de plus que le Instr utilisé dans ce contexte
un replace des matchs par le ucase mais bon (regex replace/*matchs ) double utilisation mmmmmouais........

 

[Staple1600]

Re

Je n'ai jamais écrit que ce serait un plus
Mais simplement cela mobilise le neurone et évite (may be) qu'on s'emmerde en cas de confinement sanitaire
(genre Covid-19 )
==> "bolder autrement" aka "varier les plaisirs dans VBE"

 

[patricktoulon]

Sub test()
    BoldanicolaroitalicofontAnzator [A:G], True, True, , "algerian"
End Sub

Sub BoldanicolaroitalicofontAnzator(plage As Range, _
                                    Optional gras As Boolean = False, _
                                    Optional italico As Boolean = False, _
                                    Optional couleur As Double = vbRed, _
                                    Optional FontN = "calibri")

    Dim i&, j&, chrStart&
    Set plage = plage.Resize(plage.Parent.UsedRange.Cells.Count)
    Application.ScreenUpdating = False
    For Each cel In plage.Cells
        With cel
            chrStart = InStr(1, .Text, ":")
            If chrStart > 0 Then
                With .Characters(chrStart + 1, 99)
                    .Font.Bold = gras
                    .Font.Italic = italico
                    .Font.Color = couleur
                    .Font.Name = FontN
                    'etc....
                End With
            End If
        End With
    Next

End Sub

 

[patricktoulon]

maintenant si tu veux des truc bien tordus a la délire patrickienne

Sub test2()
    With Cells(13, 1)
        x = Replace(Cells(13, 1), ":", "<b>:") & Application.Rept("</b>", Abs(InStr(.Value, ":") > 0))
        With CreateObject("htmlfile").parentwindow.clipboardData.setData("Text", "<html>" & x & "</html>"): End With
        .Select: .Parent.Paste
    End With
End Sub

LOL
oK JE sort

 

[Staple1600]

Bonsoir

•>kkamadou
La règle, l'usage, la coutume, la loi disent en choeur :
Une question=Une discussion
Donc créé une nouvelle discussion pour cette nouvelle question

 

[kkamadou]

Bonsoir
Je veux créer un fiche adhérent en passant par l'Inputbox
je veux sortir de la procédure lorsque je clique sur le bouton annuler
afficher à nouveau l'InputBox lorsque rien n'est saisi ou que la saisi n'est pas un nombre entier après avoir cliqué sur ok