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

kkamadou · 14 Mars 2020

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 · 14 Mars 2020

Re

Test OK sur mon PC

VB:

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

Staple1600 · 14 Mars 2020

Bonjour le fil, kkmadaou et ses intervenants

•>kkmadou
Essaies ceci

VB:

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 · 14 Mars 2020

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)

VB:

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 · 14 Mars 2020

Ç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 · 14 Mars 2020

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 · 14 Mars 2020

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"

VB:

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 · 14 Mars 2020

Re

Test OK sur mon PC

VB:

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 · 14 Mars 2020

re
LOL le non de la sub 😉 😀

VB:

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 · 14 Mars 2020

Re

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

patricktoulon · 14 Mars 2020

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 · 14 Mars 2020

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 · 14 Mars 2020

😀😀

VB:

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 · 14 Mars 2020

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

Code:

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 · 14 Mars 2020

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 · 15 Mars 2020

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

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

kkamadou

XLDnaute Junior

Pièces jointes

Staple1600

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

kkamadou

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

kkamadou

XLDnaute Junior

Discussions similaires

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

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency