Сохранять гиперссылки, если текст ячейки vbred

Question

У меня есть код, который удаляет гиперссылки в диапазоне.То, что я пытаюсь сделать, это сохранить гиперссылки, если текст ячейки vbRed.Код ниже, кажется, удаляет все ссылки во всех ячейках.

    Sub RemoveHyperlinks()


    Dim rng As Range
    Dim cel As Range


    Set rng = Range("CourseName")

   For Each cel In rng

    If cel <> vbRed Then

    cel.Hyperlinks.Delete

    With rng.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With

    End If
    Next cel

End Sub

Буду признателен за любую помощь.

Answer 1

Я хотел бы предложить вам сначала запустить следующие коды, чтобы получить ColorIndex ячейки. Этот код покажет вам ColorIndex в окне сообщения.

Sub GetColorIndex()
    MsgBox "Cell Interior ColorIndex: " & Range("A1").Interior.ColorIndex
    MsgBox "Cell Font ColorIndex: " & Range("A1").Font.ColorIndex
End Sub

После получения ColorIndex используйте это значение в качестве параметра условия IF. Предположим, что цвет шрифта ячейки A1 красный, тогда в окне сообщений появится ColorIndex=3. Затем используйте следующие коды для удаления гиперссылки.

Sub RemHyperlink()
    If Range("A1").Font.ColorIndex = 3 Then
        Range("A1").Hyperlinks.Delete
    End If
End Sub

Отредактированный ответ

Проверьте эту строку. If cell.DisplayFormat.Font.ColorIndex <> 3 Then Полный саб будет выглядеть следующим образом.

Sub RemoveHyperlinks()

    Dim rng As Range
    Dim cell As Range

    On Error Resume Next
    Set rng = Range("CourseName")
    On Error GoTo 0
    If rng Is Nothing Then
    Exit Sub
    End If


    For Each cell In rng
        If cell.DisplayFormat.Font.ColorIndex <> 3 Then
         cell.ClearHyperlinks
         cell.Font.Underline = False
         End If
    Next cell

End Sub

Answer 2

Ваш код проверяет, является ли значение cel 255 (значение vbRed). Вам нужно сузить проверку до атрибута вашей переменной cel, например:

If cel.Font.Color <> vbRed