最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

How can I change the font color of an cell in Excel based on its formatting using VBA? - Stack Overflow

programmeradmin0浏览0评论

I have this VBA code running on my excel sheets that takes each cell and hyperlinks it to another cell in the workbook if a text match is found. It works great, but it overwrites the cell color settings to make each cell blue and underlined. For some of the cell colors, this makes the text hard to read.

I'm looking to modify my current code to check the cell format code of the current cell in the loop and change the text color if it matches one of a certain set of values.

In my case, if the value of CELL("format", B2) returns P3, F1, F2, F3, F4, F5, or F6, I'd like the cell text color to be changed to white before the loop runs the next cell.

Here is the code working so far. Any help is greatly appreciated!

Sub mySheet()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dws As Worksheet: Set dws = wb.Sheets("mySheet")
    Dim drg As Range: Set drg = dws.Range("B2:B20")
    drg.ClearHyperlinks
    drg.Font.Underline = False
    
    Dim sws As Worksheet, scell As Range, dcell As Range
    Dim dValue As Variant, IsValueValid As Boolean

    For Each dcell In drg.Cells
        dValue = dcell.Value
        IsValueValid = False
        If Not IsError(dValue) Then
            If Len(dValue) > 0 Then IsValueValid = True
        End If
        If IsValueValid Then
            For Each sws In wb.Worksheets
                If sws.Name <> dws.Name Then
                    Set scell = sws.UsedRange.Find(What:=dValue, _
                        LookIn:=xlValues, LookAt:=xlWhole)
                    If Not scell Is Nothing Then
                        dws.Hyperlinks.Add _
                            Anchor:=dcell, _
                            Address:="", _
                            SubAddress:="'" & sws.Name & "'!" & scell.Address, _
                            TextToDisplay:=CStr(dValue)
                        Exit For
                    End If
                End If
            Next sws
        End If
        
        ' %%insert custom format code here?? %%% '

    Next dcell

    MsgBox "Hyperlinks generated.", vbInformation
    
End Sub

'''

I can't seem to find an equivalent for the CELL("format", B2) in VBA which is where I'm getting stuck even beginning the code. As an alternative, I could also check the color of the cell and if it's a certain value then I could change the text color. I tried inserting that code into the existing code but it didn't work for me - maybe I put it in the wrong place?

Sub mySheet()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dws As Worksheet: Set dws = wb.Sheets("mySheet")
    Dim drg As Range: Set drg = dws.Range("B2:B20")
    drg.ClearHyperlinks
    drg.Font.Underline = False
    
    Dim sws As Worksheet, scell As Range, dcell As Range
    Dim dValue As Variant, IsValueValid As Boolean

    For Each dcell In drg.Cells
        dValue = dcell.Value
        IsValueValid = False
        If Not IsError(dValue) Then
            If Len(dValue) > 0 Then IsValueValid = True
        End If
        If IsValueValid Then
            For Each sws In wb.Worksheets
                If sws.Name <> dws.Name Then
                    Set scell = sws.UsedRange.Find(What:=dValue, _
                        LookIn:=xlValues, LookAt:=xlWhole)
                    If Not scell Is Nothing Then
                        dws.Hyperlinks.Add _
                            Anchor:=dcell, _
                            Address:="", _
                            SubAddress:="'" & sws.Name & "'!" & scell.Address, _
                            TextToDisplay:=CStr(dValue)
                        Exit For
                    End If
                End If
            Next sws
        End If
        
       If dcell.Interior.Color = RGB(155, 0, 255) _
       Then Set dcell.Font.Color = RGB(255, 255, 255)

    Next dcell

    MsgBox "Hyperlinks generated.", vbInformation
    
End Sub

'''

I have this VBA code running on my excel sheets that takes each cell and hyperlinks it to another cell in the workbook if a text match is found. It works great, but it overwrites the cell color settings to make each cell blue and underlined. For some of the cell colors, this makes the text hard to read.

I'm looking to modify my current code to check the cell format code of the current cell in the loop and change the text color if it matches one of a certain set of values.

In my case, if the value of CELL("format", B2) returns P3, F1, F2, F3, F4, F5, or F6, I'd like the cell text color to be changed to white before the loop runs the next cell.

Here is the code working so far. Any help is greatly appreciated!

Sub mySheet()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dws As Worksheet: Set dws = wb.Sheets("mySheet")
    Dim drg As Range: Set drg = dws.Range("B2:B20")
    drg.ClearHyperlinks
    drg.Font.Underline = False
    
    Dim sws As Worksheet, scell As Range, dcell As Range
    Dim dValue As Variant, IsValueValid As Boolean

    For Each dcell In drg.Cells
        dValue = dcell.Value
        IsValueValid = False
        If Not IsError(dValue) Then
            If Len(dValue) > 0 Then IsValueValid = True
        End If
        If IsValueValid Then
            For Each sws In wb.Worksheets
                If sws.Name <> dws.Name Then
                    Set scell = sws.UsedRange.Find(What:=dValue, _
                        LookIn:=xlValues, LookAt:=xlWhole)
                    If Not scell Is Nothing Then
                        dws.Hyperlinks.Add _
                            Anchor:=dcell, _
                            Address:="", _
                            SubAddress:="'" & sws.Name & "'!" & scell.Address, _
                            TextToDisplay:=CStr(dValue)
                        Exit For
                    End If
                End If
            Next sws
        End If
        
        ' %%insert custom format code here?? %%% '

    Next dcell

    MsgBox "Hyperlinks generated.", vbInformation
    
End Sub

'''

I can't seem to find an equivalent for the CELL("format", B2) in VBA which is where I'm getting stuck even beginning the code. As an alternative, I could also check the color of the cell and if it's a certain value then I could change the text color. I tried inserting that code into the existing code but it didn't work for me - maybe I put it in the wrong place?

Sub mySheet()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dws As Worksheet: Set dws = wb.Sheets("mySheet")
    Dim drg As Range: Set drg = dws.Range("B2:B20")
    drg.ClearHyperlinks
    drg.Font.Underline = False
    
    Dim sws As Worksheet, scell As Range, dcell As Range
    Dim dValue As Variant, IsValueValid As Boolean

    For Each dcell In drg.Cells
        dValue = dcell.Value
        IsValueValid = False
        If Not IsError(dValue) Then
            If Len(dValue) > 0 Then IsValueValid = True
        End If
        If IsValueValid Then
            For Each sws In wb.Worksheets
                If sws.Name <> dws.Name Then
                    Set scell = sws.UsedRange.Find(What:=dValue, _
                        LookIn:=xlValues, LookAt:=xlWhole)
                    If Not scell Is Nothing Then
                        dws.Hyperlinks.Add _
                            Anchor:=dcell, _
                            Address:="", _
                            SubAddress:="'" & sws.Name & "'!" & scell.Address, _
                            TextToDisplay:=CStr(dValue)
                        Exit For
                    End If
                End If
            Next sws
        End If
        
       If dcell.Interior.Color = RGB(155, 0, 255) _
       Then Set dcell.Font.Color = RGB(255, 255, 255)

    Next dcell

    MsgBox "Hyperlinks generated.", vbInformation
    
End Sub

'''
Share Improve this question asked Feb 5 at 18:04 RhedogianRhedogian 11 bronze badge 2
  • 3 scell.Worksheet.Evaluate("=CELL(""format""," & scell.address & ")") should do the same as the worksheet formula – Tim Williams Commented Feb 5 at 18:19
  • 3 If you don't want cells auto-formatted as "hyperlink" you could also consider deleting that style from the workbook and applying any styling you want after adding the link. – Tim Williams Commented Feb 5 at 18:43
Add a comment  | 

1 Answer 1

Reset to default 0

Figured it out - I added this snippet at the bottom before "hyperlinks generated". Thanks @Tim Williams

 For Each dcell In drg.Cells
        dFormat = dcell.Worksheet.Evaluate("=CELL(""format""," & dcell.Address & ")")
        IsFormatValid = False
        If dFormat = "F6" Then
            dcell.Font.Color = RGB(255, 255, 255)
        End If
    Next dcell
发布评论

评论列表(0)

  1. 暂无评论