粗体细胞的特定部分 [英] Bolding a specific part of cell

问题描述

我有一个引用为="Dealer: " & CustomerName的单元格. CustomerName是字典引用的名称.我该如何只加粗经销商:"而不加粗客户名称.

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:" and not the Customer name.

示例:

经销商:乔什

我尝试过

Cells(5, 1).Characters(1, 7).Font.Bold = True

但是它似乎仅在未引用的单元格上起作用.我如何才能在引用的单元格上使用它?

But it only seems to work on non referenced cells only. How could I get this to work on a referenced cell?

推荐答案

您可以使用以下函数将公式中的某些输入文本加粗

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

因此，您现在可以在您的单元格中输入= Bold("Dealer:")& CustomerName

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

准确地说-这只会加粗字母字符(a到z和A到Z)，所有其他字符将保持不变.我尚未在其他平台上对其进行过测试，但似乎可以在我的平台上工作.并非所有字体都支持.

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

已努力重构上面的内容以显示其工作原理，而不是使用神奇的数字进行拼写.

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

有关所用unicode字符的参考，请参见此处 http://www .fileformat.info/info/unicode/block/mathematical_alphanumeric_symbols/list.htm

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

UTF16上的Wikipedia页面显示了从Unicode转换为两个UTF16代码点的算法

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

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

这篇关于粗体细胞的特定部分的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！