Bolding a specific part of cell

前端 未结 4 2156
梦毁少年i
梦毁少年i 2021-02-13 20:39

I have a cell that is referenced as =\"Dealer: \" & CustomerName. CustomerName is a dictionary referenced name. How could I go along of bolding only \"Dealer:\"

相关标签:
4条回答
  • 2021-02-13 20:59

    As they already told you can't format a partial cell value if this latter derives from a formula/function in that same cell

    However there may be some workarounds that may suit your needs

    Unluckily I can't actually grasp your real environment so here are some blind shots:


    1st "environment"

    You have a VBA code running that at some point writes in a cell like:

    Cells(5, 1).Formula = "=""Dealer: "" & CustomerName"
    

    and you want to have the "Dealer:" part bold

    • the most straightforward way would then be

      With Cells(5, 1)
          .Formula = "=""Dealer: "" & CustomerName"
          .Value = .Value
          .Characters(1, 7).Font.Bold = True
      End With
      
    • but you could also use the Worksheet_Change() event handler as follows:

      your VBA code is only

      Cells(5, 1).Formula = "=""Dealer: "" & CustomerName"
      

      while placing the following code in the relevant worksheet code pane:

      Private Sub Worksheet_Change(ByVal Target As Range)
          With Target
              If Left(.Text, 7) = "Dealer:" Then
                  Application.EnableEvents = False '<-- prevent this macro to be fired again and again by the statement following in two rows
                  On Error GoTo ExitSub
                  .Value = .Value
                  .Characters(1, 7).Font.Bold = True
              End If
          End With
      
      ExitSub:
          Application.EnableEvents = True '<-- get standard event handling back
      End Sub
      

      where On Error GoTo ExitSub and ExitSub: Application.EnableEvents = True shouldn't be necessary, but I left them as a good practice when Application.EnableEvents = False id used


    2nd "environment"

    You have cell(s) in your excel worksheet containing a formula, like:

    ="Dealer:" & CustomerName
    

    where CustomerName is a named range

    and your VBA code is going to modify the content of that named range

    in this case the Worksheet_Change() sub would be triggered by the named range value change and not by the cell containing the formula

    so I'd go checking if the changed cell is a valid one (i.e. corresponding to a well known named range) and then go with a sub that scans a predefined range and finds and format all cells with formulas that use that `named range, like follows (comments should help you):

    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        With Target
            If Not Intersect(ActiveWorkbook.Names("CustomerName").RefersToRange, Target) Is Nothing Then
                Application.EnableEvents = False '<-- prevent this macro to be fired again and again by the statement following in two rows
                On Error GoTo ExitSub
                FormatCells Columns(1), "CustomerName" '<-- call a specific sub that will properly format all cells of passed range that contains reference to passed "named range" name
            End If
        End With
    
    ExitSub:
        Application.EnableEvents = True '<-- get standard event handling back
    End Sub
    
    Sub FormatCells(rng As Range, strngInFormula As String)
        Dim f As Range
        Dim firstAddress As String
    
        With rng.SpecialCells(xlCellTypeFormulas) '<--| reference passed range cells containg formulas only
            Set f = .Find(what:=strngInFormula, LookIn:=xlFormulas, lookat:=xlPart) '<--| search for the first cell in the referenced range containing the passed formula part
            If Not f Is Nothing Then '<--| if found
                firstAddress = f.Address '<--| store first found cell address
                Do '<--| start looping through all possible matching criteria cells
                    f.Value = f.Value '<--| change current cell content into text resulting from its formula
                    f.Characters(1, 7).Font.Bold = True '<--| make its first 7 characters bold
                    Set f = .FindNext(f) '<--| search for next matching cell
                Loop While f.Address <> firstAddress '<--| exit loop before 'Find()' method wraps back to the first cell found
            End If
        End With
    End Sub
    
    0 讨论(0)
  • 2021-02-13 21:16

    Instead of referencing you could simply obtain the cells and place it in a variable, and basically append it. From here you can use the .font.bold functionality to bold a specific part. Lets say on page 2, you have "Dealer: " in cell a1, and "Josh" in b1. Here is an example how it could be done:

    Worksheets("Sheet1").Cells(5, "a") = Worksheets("Sheet2").Cells(1, "a") & Worksheets("Sheet1").Cells(1, "b")
    Worksheets("Sheet1").Cells(5, "a").Characters(1, 7).Font.Bold = True 'Bolds "dealer:" only.
    
    0 讨论(0)
  • 2021-02-13 21:21

    You can use the below function to bold some input text within a formula

    So in your cell you can now type =Bold("Dealer: ")&CustomerName

    To be precise – this will only embolden alphabetical characters (a to z and A to Z) all others will be left unchanged. I haven’t tested it on different platforms, but seems to work on mine. May not be supported for all fonts.

     Function Bold(sIn As String)
        Dim sOut As String, Char As String
        Dim Code As Long, i As Long
        Dim Bytes(0 To 3) As Byte
    
        Bytes(0) = 53
        Bytes(1) = 216
    
        For i = 1 To Len(sIn)
            Char = Mid(sIn, i, 1)
            Code = Asc(Char)
            If (Code > 64 And Code < 91) Or (Code > 96 And Code < 123) Then
                Code = Code + IIf(Code > 96, 56717, 56723)
                Bytes(2) = Code Mod 256
                Bytes(3) = Code \ 256
                Char = Bytes
            End If
            sOut = sOut & Char
        Next i
        Bold = sOut
    End Function
    

    Edit:

    Have made an effort to refactor the above to show how it works, rather than have it peppered with magical numbers.

      Function Bold(ByRef sIn As String) As String
         ' Maps an input string to the Mathematical Bold Sans Serif characters of Unicode
         ' Only works for Alphanumeric charactes, will return all other characters unchanged
    
         Const ASCII_UPPER_A As Byte = &H41
         Const ASCII_UPPER_Z As Byte = &H5A
         Const ASCII_LOWER_A As Byte = &H61
         Const ASCII_LOWER_Z As Byte = &H7A
         Const ASCII_DIGIT_0 As Byte = &H30
         Const ASCII_DIGIT_9 As Byte = &H39
         Const UNICODE_SANS_BOLD_UPPER_A As Long = &H1D5D4
         Const UNICODE_SANS_BOLD_LOWER_A As Long = &H1D5EE
         Const UNICODE_SANS_BOLD_DIGIT_0 As Long = &H1D7EC
    
         Dim sOut As String
         Dim Char As String
         Dim Code As Long
         Dim i As Long
    
         For i = 1 To Len(sIn)
            Char = Mid(sIn, i, 1)
            Code = AscW(Char)
            Select Case Code
               Case ASCII_UPPER_A To ASCII_UPPER_Z
                  ' Upper Case Letter
                  sOut = sOut & ChrWW(UNICODE_SANS_BOLD_UPPER_A + Code - ASCII_UPPER_A)
               Case ASCII_LOWER_A To ASCII_LOWER_Z
                  ' Lower Case Letter
                  sOut = sOut & ChrWW(UNICODE_SANS_BOLD_LOWER_A + Code - ASCII_LOWER_A)
               Case ASCII_DIGIT_0 To ASCII_DIGIT_9
                  ' Digit
                  sOut = sOut & ChrWW(UNICODE_SANS_BOLD_DIGIT_0 + Code - ASCII_DIGIT_0)
               Case Else:
                  ' Not available as bold, return input character
                  sOut = sOut & Char
            End Select
         Next i
         Bold = sOut
      End Function
    
      Function ChrWW(ByRef Unicode As Long) As String
         ' Converts from a Unicode to a character,
         ' Includes the Supplementary Tables which are not normally reachable using the VBA ChrW function
    
         Const LOWEST_UNICODE As Long = &H0              '<--- Lowest value available in unicode
         Const HIGHEST_UNICODE As Long = &H10FFFF        '<--- Highest vale available in unicode
         Const SUPPLEMENTARY_UNICODE As Long = &H10000   '<--- Beginning of Supplementary Tables in Unicode. Also used in conversion to UTF16 Code Units
         Const TEN_BITS As Long = &H400                  '<--- Ten Binary Digits - equivalent to 2^10. Used in converstion to UTF16 Code Units
         Const HIGH_SURROGATE_CONST As Long = &HD800     '<--- Constant used in conversion from unicode to UTF16 Code Units
         Const LOW_SURROGATE_CONST As Long = &HDC00      '<--- Constant used in conversion from unicode to UTF16 Code Units
    
         Dim highSurrogate As Long, lowSurrogate As Long
    
         Select Case Unicode
            Case Is < LOWEST_UNICODE, Is > HIGHEST_UNICODE
               ' Input Code is not in unicode range, return null string
               ChrWW = vbNullString
            Case Is < SUPPLEMENTARY_UNICODE
               ' Input Code is within range of native VBA function ChrW, so use that instead
               ChrWW = ChrW(Unicode)
            Case Else
               ' Code is on Supplementary Planes, convert to two UTF-16 code units and convert to text using ChrW
               highSurrogate = HIGH_SURROGATE_CONST + ((Unicode - SUPPLEMENTARY_UNICODE) \ TEN_BITS)
               lowSurrogate = LOW_SURROGATE_CONST + ((Unicode - SUPPLEMENTARY_UNICODE) Mod TEN_BITS)
               ChrWW = ChrW(highSurrogate) & ChrW(lowSurrogate)
         End Select
    
      End Function
    

    For reference on the unicode characters used see here http://www.fileformat.info/info/unicode/block/mathematical_alphanumeric_symbols/list.htm

    The wikipedia page on UTF16 shows the algorithm for converting from Unicode to two UTF16 code points

    https://en.wikipedia.org/wiki/UTF-16

    0 讨论(0)
  • 2021-02-13 21:25

    Requirements:

    My understanding is that the OP needs to have in cell A5 the result of the formula ="Dealer: " & CustomerName showing the Dealer: part in bold characters. Now, what it is not clear, is the nature of the CustomerName part of the formula. This solution assumes it corresponds to a Defined Name with workbook scope (let me know if different).

    I assume that the reason for using a formula and not writing directly the result of the formula and formatting the A5 cell with a VBA procedure is to allow users to see the data from different customers just by a calculation change in the workbook, rather than by running a VBA procedure.

    Let say that we have the following data in a worksheet named Report, were the Defined Name CustomerName has a workbook scope and is hidden. Located at A5 is the formula ="Dealer: " & CustomerName The Fig.1 shows the report with the data for Customer 1.

    Fig.1

    Now if we change the Customer Number in cell E3 to 4, the report will show the data of the customer selected; without running any VBA procedure. Unfortunately as the cell A5 contains a formula its contents font cannot be partially formatted to show “Dealer: ” in bold characters. The Fig.2 shows the report with the data for Customer 4.

    Fig.2

    The solution proposed herewith is to Dynamically display the contents of a cell or range in a graphic object

    To implement this solution we need to recreate the desired Output Range and add a Shape in A5 that will contain a link to the Output Range. Assuming that we don’t want this Output Range to be seen in the same worksheet were the report is, and keeping mind that the Output Range cells cannot be hidden; let’s create this Output Range in another worksheet named “Customers Data” at B2:C3 (see Fig.3). Enter in B2 Dealer: and in C2 enter the formula =Customer Name then format each cell as required (B2 font bold, C3 can have a different font type if you like – let’s apply font italic for this sample). Ensure the range have the appropriated width so the text does not overflows the cells.

    Fig.3

    It’s suggested to create a Defined Name for this range. The code below creates the Defined Name called RptDealer.

    Const kRptDealer As String = "RptDealer" ‘Have this constant at the top of the Module. It is use by two procedures
    
    Sub Name_ReportDealerName_Add()
    'Change Sheetname "Customers Data" and Range "B2:C2" as required
        With ThisWorkbook.Sheets("Customers Data")
            .Cells(2, 2).Value = "Dealer: "
            .Cells(2, 2).Font.Bold = True
            .Cells(2, 3).Formula = "=CustomerName"  'Change as required
            .Cells(2, 3).Font.Italic = True
            With .Parent
                .Names.Add Name:=kRptDealer, RefersTo:=.Sheets("Customers Data").Range("B2:C2") ', _
                    Visible:=False 'Visible is True by Default, use False want to have the Name hidden to users
                .Names(kRptDealer).Comment = "Name use for Dealer\Customer picture in report"
            End With
            .Range(kRptDealer).Columns.AutoFit
        End With
        End Sub
    

    Following the above preparations , now we can create the Shape that will be linked to the Output Range named RptDealer. Select at cell A5 in worksheet Report and follow the instructions for Dynamically display cell range contents in a picture or if you prefer use the code below to add and format the linked Shape.

    Sub Shape_DealerPicture_Set(rCll As Range)
    Const kShpName As String = "_ShpDealer"
    Dim rSrc As Range
    Dim shpTrg As Shape
    
        Rem Delete Dealer Shape if present and set Dealer Source Range
        On Error Resume Next
        rCll.Worksheet.Shapes(kShpName).Delete
        On Error GoTo 0
    
        Rem Set Dealer Source Range
        Set rSrc = ThisWorkbook.Names(kRptDealer).RefersToRange
    
        Rem Target Cell Settings & Add Picture Shape
        With rCll
            .ClearContents
            If .RowHeight < rSrc.RowHeight Then .RowHeight = rSrc.RowHeight
            If .ColumnWidth < rSrc.Cells(1).ColumnWidth + rSrc.Cells(2).ColumnWidth Then _
                .ColumnWidth = rSrc.Cells(1).ColumnWidth + rSrc.Cells(2).ColumnWidth
            rSrc.CopyPicture
            .PasteSpecial
            Selection.Formula = rSrc.Address(External:=1)
            Selection.PrintObject = msoTrue
            Application.CutCopyMode = False
            Application.Goto .Cells(1)
            Set shpTrg = .Worksheet.Shapes(.Worksheet.Shapes.Count)
        End With
    
        Rem Shape Settings
        With shpTrg
            On Error Resume Next
            .Name = "_ShpDealer"
            On Error GoTo 0
            .Locked = msoFalse
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            .ScaleHeight 1, msoTrue
            .ScaleWidth 1, msoTrue
            .LockAspectRatio = msoTrue
            .Placement = xlMoveAndSize
            .Locked = msoTrue
        End With
    
        End Sub
    

    The code above can be called using this procedure:

    Sub DealerPicture_Apply()
    Dim rCll As Range
        Set rCll = ThisWorkbook.Sheets("Report").Cells(5, 1)
        Call Shape_DealerPicture_Set(rCll)
        End Sub
    

    The end result is a Picture that behaves like a formula as it is linked to the Output Range containing the formula and format desired (see Fig.4)

    Fig.4

    0 讨论(0)
提交回复
热议问题