office交流网--QQ交流群号

Access培训群:792054000         Excel免费交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

为单元格里的各个文字设置不同的字体和颜色(甚至可以隐藏部分数据而实现加密保密数据的功能)

2020-05-29 08:00:00
zstmtony
原创
3348


  Dim strText As String
  Dim intLen As Integer
  Dim i As Integer
  Dim strResult As String
  Dim intTimes As Integer
  Dim intPos As Integer
  Dim strConfuseCode As String
  Dim strPos As String  ' 0,3,5,8
  Dim varPos As Variant
  Dim intStart As Integer
  Dim intCellStart As Integer
  strPos = "3,5"
  varPos = Split(strPos, ",")
  strText = Range("G2").Text
 
  intStart = 1
  For i = 0 To UBound(varPos)
    intPos = varPos(i)
    If intPos = 0 Then
       strConfuseCode = getRndChar(5)
       intLen = Len(strConfuseCode)
       Range("H2") = Range("H2") & strConfuseCode
    Else
       intCellStart = Len(Range("H2").Text) + 1
       Range("H2").Value = Range("H2").Value & Mid(strText, intStart, intPos - intStart + 1)
      
       Range("H2").Characters(intCellStart, intPos - intStart + 1).Font.Size = 11
       Range("H2").Characters(intCellStart, intPos - intStart + 1).Font.Color = vbBlack
      
       intStart = intPos + 1
       intCellStart = Len(Range("H2").Text) + 1
       strConfuseCode = getRndChar(5)
       intLen = Len(strConfuseCode)
       Range("H2").Value = Range("H2").Value & strConfuseCode
       Range("H2").Characters(intCellStart, intLen).Font.Size = 1
       Range("H2").Characters(intCellStart, intLen).Font.Color = vbWhite
      
    End If
  Next
  intStart = intPos + 1
  intCellStart = Len(Range("H2").Text) + 1
  Range("H2").Value = Range("H2").Value & Mid(strText, intStart)  '只要一赋值,就会清除里面为独立内容设置字体的格式。所以必须 先一次性设置好value,再设置格式
  Range("H2").Characters(intCellStart, Len(Range("H2").Text) - intStart + 1).Font.Size = 11
       Range("H2").Characters(intCellStart, Len(Range("H2").Text) - intStart + 1).Font.Color = vbBlack


可以实现 可以隐藏部分数据而实现加密保密数据的功能

也可实现 为现有数据加上混淆码 或干扰码,达到避免被人直接复制数据的效果。即直接复制数据中会有干扰码。但显示正常

分享