Mettre en gras les séries de caractères entre quotes

Bonjour à tous !

Je souhaite mettre en gras les mots/groupes de mots (ou de chiffres) entre 2 quotes. Pouvez vous m'aider svp ? Je vous joins en attachement un exemple d'une longue liste que je souhaite mettre en forme avec cette condition. Merci de votre aide!

Bonjour izara booki, le forum,

Voici une solution par macro.

Cliquez sur le bouton 'Clic' et tous les caractères entre guillemets se mettront en gras. Bien sûr, il faut accepter les macros.

Votre classeur :

PS: veuillez préciser votre version d'Excel (ex : 2007, 2013, 365)

Cordialement.

AL 22

Bonjour à tous,

Vois ceci :

Sub test1()
    Dim rng As Range, r As Range
    With Sheets("Feuil1")
        Set rng = .Range("c2", .Range("c" & Rows.Count).End(xlUp))
        rng.Font.Bold = False
        With CreateObject("VBScript.RegExp")
            .Global = True
            .Pattern = """(.+?)"""
            For Each r In rng
                If .test(r) Then
                    For Each m In .Execute(r)
                        r.Characters(m.firstindex + 2, m.Length - 2).Font.Bold = True
                        'r.Characters(m.firstindex + 2, m.Length - 2).Font.ColorIndex = 44
                    Next
                End If
            Next
        End With
    End With
End Sub

klin89

Bonjour,

Pour ne mettre qu'une partie du texte de chaque cellule il faut passer par le VBA. Ci-après une proposition et le code correspondant.

Option Explicit
Public Const QUOTATION_CHAR As String * 1 = """"

' UI button
Sub buttonClick()
  Dim cell As Range
  For Each cell In Selection
    BoltQuotesInCell cell
  Next cell
End Sub

' finding quotation marks
Private Function getQuotesIndexes(str As String) As Long()
  Dim quotesIndexesList() As Long
  ReDim quotesIndexesList(0 To 0)

  Dim searchStart As Long
  searchStart = 1
  Dim lastQuoteIndex As Long
  lastQuoteIndex = 0

  If InStr(searchStart, str, QUOTATION_CHAR) = 0 Then
    getQuotesIndexes = quotesIndexesList
    Exit Function
  End If

  While searchStart < Len(str)
    lastQuoteIndex = InStr(searchStart, str, QUOTATION_CHAR)
    searchStart = lastQuoteIndex + 1

    quotesIndexesList(UBound(quotesIndexesList)) = lastQuoteIndex

    If lastQuoteIndex = 0 Then
      searchStart = Len(str)
    Else
      ReDim Preserve quotesIndexesList(0 To UBound(quotesIndexesList) + 1)
    End If
  Wend

  ReDim Preserve quotesIndexesList(0 To UBound(quotesIndexesList) - 1)
  getQuotesIndexes = quotesIndexesList
End Function

' applying bolt effect on text
Private Sub BoltQuotesInCell(cell As Range)
  Dim quotesIndexes() As Long
  quotesIndexes = getQuotesIndexes(cell.Text)

  Dim imax As Long
  imax = UBound(quotesIndexes) + 1

  If imax Mod 2 <> 0 Then
    MsgBox "Quotations fermantes manquantes !"
    Exit Sub
  Else
    Dim k As Long
    For k = 0 To imax \ 2 Step 2
      cell.Characters( _
        Start:=quotesIndexes(k) + 1, _
        Length:=quotesIndexes(k + 1) - quotesIndexes(k) - 1 _
      ).Font.FontStyle = "Bold"
    Next k
  End If
End Sub

'''''''''''''''''''''''''
' Test subs
'''''''''''''''''''''''''
Private Sub testIndexes()
  Dim elt
  For Each elt In getQuotesIndexes(ThisWorkbook.Worksheets(1).Range("c20").Text)
    Debug.Print elt
  Next elt
End Sub

Private Sub testHighlight()
  BoltQuotesInCell ThisWorkbook.Worksheets(1).Range("C4")
End Sub

Merci à vous les gars pour vos réponses !

Problème résolu ! Le macro de ALL 22 fonctionne super bien, merci beaucoup. J'ai la version 2013.

Bonne journée à toutes et à tous!