[分享]VBA实现单元格条件格式的属性、方法

tw0503

学到很多，谢谢

hlopr

谢谢楼主，收藏学习！

smshijiea

支持啊，非常感谢，好好学学

飞云楼主

好东东，收下学习。向楼主致敬。

dllaozeng

辛苦了，正好用得着！！！

single_star

呵呵,想不到我跟楼主写的代码思路几乎一模一样(以下代码新增边框格式转换)
（樓主备注：本过程参考修订了：http://www.vbeach.net/bbs/archiver/?tid-6471.html处的代码,不知是否我以前在该处写的代码,我当时的ID名是stardust,不过该网站现在关闭了）


Sub Translate_Formatconditions_Celltype()
Set range0 = Application.Intersect(Selection, ActiveCell.SpecialCells(xlCellTypeAllFormatConditions))
If range0 Is Nothing Then Exit Sub
'*************************************************
Application.ScreenUpdating = False
Dim jd(8)      'set this for 8 FormatConditionOperator
jd(1) = "=And(cell0>=for1,cell0<=for2)"    'Between
jd(2) = "=Not(And(cell0>=for1,cell0<=for2))"       'notBetween
jd(3) = "=cell0=for1"               '=
jd(4) = "=cell0<>for1"              '<>
jd(5) = "=cell0>for1"               '>
jd(6) = "=cell0<for1"               '<
jd(7) = "=cell0>=for1"              '>=
jd(8) = "=cell0<=for1"              '<=

For Each sel0 In range0
n = sel0.FormatConditions.Count
  con = 0
  For i = n To 1 Step -1
  With sel0
  sel0.Select 'use this to avoid formula wrong answer with row() or column()
'****.FormatConditions(i).Type: xlCellValue
  If .FormatConditions(i).Type = 1 Then
    s0 = sel0.Value2
    operator0 = .FormatConditions(i).Operator
    a0 = Application.Evaluate(.FormatConditions(i).Formula1)
    If operator0 = 1 Or operator0 = 2 Then
    b0 = Application.Evaluate(.FormatConditions(i).Formula2)
    If Not (IsNumeric(s0)) Or Not (IsNumeric(a0)) Or Not (IsNumeric(b0)) Then
      If IsEmpty(s0) Then s0 = ""
      If IsNumeric(s0) Then s0 = CStr(s0)
      If IsEmpty(a0) Then a0 = ""
      If IsNumeric(a0) Then a0 = CStr(a0)
      If IsEmpty(b0) Then b0 = ""
      If IsNumeric(b0) Then b0 = CStr(b0)
      Else
      If IsEmpty(s0) Then s0 = 0
      If IsEmpty(a0) Then a0 = 0
      If IsEmpty(b0) Then b0 = 0
    End If

      If a0 > b0 Then
       a1 = b0
       b1 = a0
      Else
       a1 = a0
       b1 = b0
      End If
    Else
      a1 = a0
    End If
       If Application.WorksheetFunction.IsText(s0) Then s0 = """" & UCase(s0) & """"
      If Application.WorksheetFunction.IsText(a1) Then a1 = """" & UCase(a1) & """"
      If Application.WorksheetFunction.IsText(b1) Then b1 = """" & UCase(b1) & """"
      st0 = jd(operator0)
      st = Replace(st0, "for1", a1)
      st = Replace(st, "for2", b1)
      st = Replace(st, "cell0", s0)
      If Application.WorksheetFunction.IsError(Application.Evaluate(st)) Then
        ans = False
      Else
       ans = Application.Evaluate(st)
      End If
'****.FormatConditions(i).Type:xlExpression
    Else
      If Application.WorksheetFunction.IsError(Application.Evaluate(.FormatConditions(i).Formula1)) Then
        ans = False
      Else
       ans = Application.Evaluate(.FormatConditions(i).Formula1)
      End If
    End If
  End With
  If ans = True Then con = i
  Next
'***translate celltype(Font&Interior&Borders)
If con > 0 Then
  Set s1 = sel0.FormatConditions(con).Font
  Set s2 = sel0.FormatConditions(con).Interior
  With sel0.Font
    .Bold = s1.Bold
    .Italic = s1.Italic
    .Underline = s1.Underline
    .Strikethrough = s1.Strikethrough
    .ColorIndex = s1.ColorIndex
  End With
  sel0.Interior.Pattern = s2.Pattern
  sel0.Interior.ColorIndex = s2.ColorIndex
   
  For b0 = 1 To 4
   If sel0.FormatConditions(con).Borders(b0).LineStyle <> xlNone Then
      sel0.Borders(b0).LineStyle = sel0.FormatConditions(con).Borders(b0).LineStyle
      sel0.Borders(b0).Weight = sel0.FormatConditions(con).Borders(b0).Weight
      sel0.Borders(b0).ColorIndex = sel0.FormatConditions(con).Borders(b0).ColorIndex
   End If
  Next
End If

sel0.FormatConditions.Delete
Next
Application.ScreenUpdating = True
End Sub

[ 本帖最后由 single_star 于 2010-1-4 08:45 编辑 ]

老伙计2008

好东东，收下学习。向楼主致敬。收藏！

lzyamo3057

学习了，谢谢楼主

jxhm0520

谢谢分享！

lzqlaj

好贴子，终于弄明白了边框的意义。