Bolding a specific part of cell

前端 未结 4 2154
梦毁少年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 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

提交回复
热议问题