VBA陰影交替行

Question

使用this網站作爲源，我已經放在一起this工作簿提取並列出給定文件夾中的文件。

的代碼工作正常，但我想通過在陰影列中的交替行，以適應這一點了C，d和E

我研究這一點，並找到了一個例子here

我得到的問題是，我只能設置陰影列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 

我只是想知道是否有人能夠看到這個請讓我知道我出了什麼問題。

Answer 1

對於那些誰感興趣，這是我工作的代碼：

公用Sub ListFilesInFolder（SourceFolder作爲Scripting.folder，IncludeSubfolders由於布爾）

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 

Answer 2

試試這個，找「添加」評論。另外，請注意，我只是爲其他顏色條紋選擇了另一種顏色 - 您可以將其更改爲適合您的需要。

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 

Answer 3

除非我遺漏了一些東西，否則不需要單元格中的公式來創建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