Sub ChangeTextColor()
    Dim shp As Shape
    Dim rng As TextRange
    Dim currentColor As String
    Dim newColor As String
    Dim userInput As String
    Dim sel As Selection
    Dim fontColor As Long
    Dim colorCount As Collection

    ' 선택된 텍스트 가져옴
    On Error Resume Next
    Set sel = ActiveWindow.Selection

    If sel.Type = ppSelectionText Then
        Set rng = sel.TextRange
    ElseIf sel.Type = ppSelectionShapes Then
        If sel.ShapeRange(1).HasTextFrame Then
            Set rng = sel.ShapeRange(1).TextFrame.TextRange
        End If
    End If

    On Error GoTo 0

    ' 선택된 텍스트가 없으면 메시지 표시
    If rng Is Nothing Or rng.Text = "" Then
        MsgBox "텍스트를 선택하세요.", vbExclamation
        Exit Sub
    End If

    ' 텍스트 색상 개수 확인
    Set colorCount = New Collection
    On Error Resume Next
    Dim i As Integer
    For i = 1 To rng.Characters.Count
        colorCount.Add rng.Characters(i).Font.Color.RGB, CStr(rng.Characters(i).Font.Color.RGB)
    Next i
    On Error GoTo 0

    If colorCount.Count > 1 Then
        MsgBox "텍스트 상자에 색상이 2개 이상 있습니다. 하나의 색상 텍스트만 선택하세요.", vbExclamation
        Exit Sub
    End If

    ' 현재 텍스트 색상 코드 가져오기
    fontColor = rng.Font.Color.RGB
    currentColor = Right("000000" & Hex(fontColor), 6)

    ' 입력 박스 구성 (한 줄 입력)
    userInput = InputBox("현재 텍스트 색상 코드: #" & currentColor & vbCrLf & _
                         "변경할 텍스트 색상 코드 (6자리, 예: 123ABC):", "텍스트 색상 변경")

    ' 입력값 유효성 검사
    If Len(userInput) <> 6 Or Not IsHex(userInput) Then
        MsgBox "올바른 6자리 색상 코드를 입력하세요.", vbExclamation
        Exit Sub
    End If

    ' 색상 변경
    newColor = RGB(CInt("&H" & Mid(userInput, 1, 2)), _
                   CInt("&H" & Mid(userInput, 3, 2)), _
                   CInt("&H" & Mid(userInput, 5, 2)))

    On Error Resume Next
    ' 모든 텍스트 색상 변경
    Dim sld As Slide
    Dim s As Shape
    Dim tr As TextRange
    For Each sld In ActivePresentation.Slides
        For Each s In sld.Shapes
            If s.HasTextFrame Then
                Set tr = s.TextFrame.TextRange
                For i = 1 To tr.Characters.Count
                    If Right("000000" & Hex(tr.Characters(i).Font.Color.RGB), 6) = currentColor Then
                        tr.Characters(i).Font.Color.RGB = newColor
                    End If
                Next i
            End If
        Next s
    Next sld
    On Error GoTo 0

    MsgBox "텍스트 색상이 변경되었습니다.", vbInformation
End Sub

Function IsHex(value As String) As Boolean
    Dim i As Integer
    IsHex = True
    For i = 1 To Len(value)
        Select Case Mid(value, i, 1)
            Case "0" To "9", "A" To "F", "a" To "f"
                ' Do nothing, valid character
            Case Else
                IsHex = False
                Exit Function
        End Select
    Next i
End Function