Excel VBA阴影交替行

Excel VBA阴影交替行,excel,excel-2013,vba,Excel,Excel 2013,Vba,使用站点作为源,我将工作簿放在一起,其中提取并列出了给定文件夹中的文件 代码运行得很好,但我正试图通过对C、D和E列中的交替行进行着色来稍微调整这一点 我对此进行了研究,并找到了一个例子 我遇到的问题是,我只能对列E进行着色,我不知道为什么。我也想给另一排遮阴,但我有点不确定该怎么做 这是提取文件并对行进行着色的代码 Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, IncludeSubfolders As Boolea

使用站点作为源,我将工作簿放在一起,其中提取并列出了给定文件夹中的文件

代码运行得很好,但我正试图通过对C、D和E列中的交替行进行着色来稍微调整这一点

我对此进行了研究,并找到了一个例子

我遇到的问题是,我只能对列
E
进行着色,我不知道为什么。我也想给另一排遮阴,但我有点不确定该怎么做

这是提取文件并对行进行着色的代码

Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, IncludeSubfolders As Boolean)
    Dim lngLastRow As Long
    On Error Resume Next
    For Each FileItem In SourceFolder.Files
        ' display file properties
        Cells(iRow, 3).Formula = iRow - 13
        Cells(iRow, 4).Formula = FileItem.Name
        Cells(iRow, 5).Select
        Selection.Hyperlinks.Add Anchor:=Selection, Address:= _
        FileItem.Path, TextToDisplay:="Click Here to Open"
        iRow = iRow + 1 ' next row number

        lngLastRow = Sh.Cells(Cells.Rows.Count, "C").End(xlUp).Row
        Range("C14:E" & lngLastRow).Activate
        Selection.FormatConditions.Delete
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=0"

        Selection.FormatConditions(1).Interior.ColorIndex = 24

    Next FileItem

    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder, True
        Next SubFolder
    End If
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

我只是想知道是否有人可以看看这个,请告诉我哪里出了问题。

试试看,看看“添加”评论。另外,请注意,我刚刚为其他颜色条选择了另一种颜色-您可以根据需要更改它

Public Sub ListFilesInFolder(SourceFolder As Scripting.folder, _
           IncludeSubfolders As Boolean)
Dim lngLastRow As Long
Dim Toggle as integer           'added this here

On Error Resume Next
Toggle = 0
For Each FileItem In SourceFolder.Files
' display file properties
    Cells(iRow, 3).Formula = iRow - 13
    Cells(iRow, 4).Formula = FileItem.Name
    Cells(iRow, 5).Select
    Selection.Hyperlinks.Add Anchor:=Selection, Address:= _
          FileItem.Path, TextToDisplay:="Click Here to Open"
    iRow = iRow + 1 ' next row number
    lngLastRow = Sh.Cells(Cells.Rows.Count, "C").End(xlUp).Row
    Range("C14:E" & lngLastRow).Activate
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, _
               Formula1:="=MOD(ROW(),2)=0"
    '-----------------------------------
    'Add this section here
    if toggle = 0 then
      Selection.FormatConditions(1).Interior.ColorIndex = 24
      toggle = 1
    Else
      Selection.FormatConditions(1).Interior.ColorIndex = 42
      toggle = 0
    end if

Next FileItem

If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.SubFolders
        ListFilesInFolder SubFolder, True
    Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub

除非我遗漏了什么,否则您不需要单元格中的公式来创建VBA控制的备用着色方案。在没有文件目录代码的情况下,我创建了一个快速例程,只对C、D和E列的备用行进行着色

如果您可以从上面的例程中删除FormatConditions代码,这可能是一个可以接受的替代

Sub ReShade(startRow As Integer, endRow As Integer)
    '--- begin by "erasing" the previous row coloring
    ActiveSheet.Range(Cells(startRow, 3), Cells(endRow, 5)).Interior.ColorIndex = xlNone
    '--- shades alternate rows in columnd C, D, E
    Dim r As Integer
    Dim rowCells As Range
    For r = startRow To endRow Step 2
        Set rowCells = ActiveSheet.Range(Cells(r, 3), Cells(r, 5))
        With rowCells
            .Interior.ColorIndex = 24
        End With
    Next r
End Sub

'--- call ReShade at the end of your routine, as in...
Sub test()
    ReShade 5, 20  
End Sub

对于感兴趣的人,这是我的工作代码:

Public Sub-ListFilesInFolder(SourceFolder为Scripting.folder,IncludeSubfolders为Boolean)


并不是每个人都能从他们的工作环境中访问Dropbox,当你的问题得到回答时,你有可能/可能会从那里删除该文件。您最好在您的问题中发布相关代码,以提供我们正在寻找的持久相关性。这是一个在后期编辑时评论的经典案例……嗨@Freeman,感谢您抽出时间回复我的帖子,以及对“Dropbox”文件的评论。也谢谢你的代码。我试过了,但不幸的是第二个单元格没有阴影。非常感谢和亲切的问候。克里萨,我刚意识到你在做什么。忽略我建议的所有更改。手动检查已修改的单元格,查看其上有多少
FormatConditions
。我的猜测是您设置了错误的
Interior.ColorIndex
。要么有倍数,要么索引应该是
(0)
。嗨@Freeman,我只是想让你知道我用了。非常感谢和亲切的问候。圣诞快乐@IRHM!很高兴你找到了解决办法。这基本上就是我要说的,不幸的是,我混合了你的条件格式和我的显式格式,这造成了问题。我建议您输入最终代码作为答案,稍后再回来接受它。这将有助于下一个找到你的帖子的人——更容易看到一个有标记的答案,而不是在评论中发现它。
    Dim LastRow As Long

    On Error Resume Next
    For Each FileItem In SourceFolder.Files
        ' display file properties
        Cells(iRow, 3).Formula = iRow - 12
        Cells(iRow, 4).Formula = FileItem.Name
        Cells(iRow, 5).Select
        Selection.Hyperlinks.Add Anchor:=Selection, Address:= _
        FileItem.Path, TextToDisplay:="Click Here to Open"
        iRow = iRow + 1 ' next row number

        With ActiveSheet
            LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
            LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End With

        For Each Cell In Range("C13:E" & LastRow) ''change range accordingly
            If Cell.Row Mod 2 = 1 Then ''highlights row 2,4,6 etc|= 0 highlights 1,3,5
                Cell.Interior.Color = RGB(232, 232, 232) ''color to preference
            Else
                Cell.Interior.Color = RGB(141, 180, 226) 'color to preference or remove
            End If
        Next Cell
    Next FileItem

    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder, True
        Next SubFolder
    End If
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub