[VBA] Characters.Font.Color Error

작성된 시트에서 셀내 글자색을 지정하여 사용한 경우 

일부 글자색을 다른 글자색으로 일괄 변경하는 매크로입니다.

Cell.Characters(i, j).Font.Color를 이용해서 하는 작업인데,

사용중 알 수 없는 오류가 발생하는 경우가 있습니다.

Sub FontColorChange1()
  Dim C As Range, iCnt As Long, i As Long
  Dim Color1 As Long, Color2 As Long, Color3 As Long, Color4 As Long, Color5 As Long, Color6 As Long, Color7 As Long, Color8 As Long, Color9 As Long, Color10 As Long, Color11 As Long, Color12 As Long
  
  Color1 = RGB(0, 176, 80): Color2 = RGB(204, 204, 0)  '// 녹색 → 황색 변경
  '// 여러색일 경우 여기에 변경전/후 쌍을 추가
    
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  
  For Each C In Selection   'ActiveSheet.UsedRange.Cells
    On Error Resume Next
    iCnt = 0
    iCnt = C.Characters.Count
    If iCnt > 0 Then
      For i = 1 To Len(C.Value2)
        Select Case C.Characters(i, 1).Font.Color
        Case Color1: C.Characters(i, 1).Font.Color = Color2
        '// 여러색일 경우 여기에 Case 추가
        Case Else
        End Select
      Next
    End If
  Next C

  Application.ScreenUpdating = True
  Application.EnableEvents = True
  MsgBox "완료되었습니다."

End Sub

매크로 사용할 때 이상한 현상이 나온 것입니다.

발생하는 부위가 일정하지도 않고,  작업이 이루어지지 않은 부분이 변경되어 버리는 이상한 현상입니다.

글자 하나하나 처리하는 것이 Excel에서 자연스럽게 처리되지 않아서 그런 듯 한데...

 

Excel의 파일 구성을 보면 텍스트가 글자색 단위로 끊어서 저장되어 있습니다.

그래서 혹시나 하고,,, 글자색 단위로 처리하도록 매크로를 수정합니다.

이렇게 적용했더니 더이상 이상한 오류가 발생하지 않았습니다.

Sub FontColorChange2()
  Dim C As Range, iCnt As Long, iLR As Long, iLC As Long, i As Long, iPos As Long, iLen As Long
  Dim Color1 As Long, Color2 As Long, Color3 As Long, Color4 As Long, Color5 As Long, Color6 As Long, Color7 As Long, Color8 As Long, Color9 As Long, Color10 As Long, Color11 As Long, Color12 As Long
  
  Color1 = RGB(0, 176, 80): Color2 = RGB(204, 204, 0)  '// 녹색 → 황색 변경
    
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  
  On Error Resume Next
  
  For Each C In Selection 	'ActiveSheet.UsedRange.Cells
      iCnt = 0
      iCnt = C.Characters.Count
      If iCnt > 0 Then
          '// 아래를 변경하려는 Color 별로 호출
          CharacterFontColorChange C, Color1, Color2
      End If
  Next C

  Application.ScreenUpdating = True
  Application.EnableEvents = True
  MsgBox "완료되었습니다."

End Sub

Sub CharacterFontColorChange(C As Range, FromC As Long, ToC As Long)
    Dim iCnt As Long, iPos As Long, iLen As Long, i As Long
    With C
      iCnt = 0
      iCnt = .Characters.Count
      If iCnt > 0 Then
        
        iPos = 0: iLen = 0: i = 0
        Do While True
          i = i + 1
          If i > iCnt Then Exit Do
          If .Characters(i, 1).Font.Color = FromC Then
              If iPos = 0 Then iPos = i: iLen = iLen + 1 Else iLen = iLen + 1
          Else
              If iPos > 0 Then .Characters(iPos, iLen).Font.Color = ToC: iPos = 0: iLen = 0
          End If
        Loop
      End If
    End With
End Sub

 

CharatersFontColorChange.xlsm

0.03MB