WORD中的表格填充颜色

buguiize

问：如何快速从20页开始，如果表格中最后1列的数据为0，填充所在的行为灰颜色。

buguiize

请教大神解答

kqbt

测试下列代码前，请自行备份好原文档。

1. Sub RowsShadingGray()
   
2.   Dim wRng As Range, cRng As Range, wTab As Table, iRow As Integer
   
3.   On Error Resume Next
   
4.   Application.ScreenUpdating = False
   
5.   Selection.GoTo wdGoToPage, , , "20" 'InputBox("请输入起始页码：", , 20)
   
6.   Set wRng = ActiveDocument.Range(Selection.Range.Start, ActiveDocument.Range.End - 1)
   
7.   For Each wTab In wRng.Tables
   
8.     For iRow = 1 To wTab.Rows.Count
   
9.       wTab.Cell(iRow, 1).Select
   
10.       Selection.SelectRow
    
11.       Set cRng = Selection.Cells(Selection.Cells.Count).Range
    
12.       If ActiveDocument.Range(cRng.Start, cRng.End - 1) = "0" Then
    
13.         Selection.Shading.BackgroundPatternColor = wdColorGray25
    
14.       End If
    
15.     Next
    
16.   Next
    
17.   Application.ScreenUpdating = True
    
18. End Sub

复制代码

buguiize

kqbt 发表于 2016-7-20 09:55
测试下列代码前，请自行备份好原文档。

谢谢，填充颜色的功能实现了，可是要让排名的顺序保持不变！

kqbt

buguiize 发表于 2016-7-20 14:13
谢谢，填充颜色的功能实现了，可是要让排名的顺序保持不变！

我没动排名顺序。

buguiize

buguiize 发表于 2016-7-20 14:13
谢谢，填充颜色的功能实现了，可是要让排名的顺序保持不变！

算是一点美中不足

kqbt

测试下列代码前，请自行备份好原文档。

1. Sub RowsShadingGray()
   
2.   Dim wRng As Range, cRng As Range, wTab As Table, iRow As Integer
   
3.   On Error Resume Next
   
4.   Application.ScreenUpdating = False
   
5.   Selection.GoTo wdGoToPage, , , "20" 'InputBox("请输入起始页码：", , 20)
   
6.   Set wRng = ActiveDocument.Range(Selection.Range.Start, ActiveDocument.Range.End - 1)
   
7.   For Each wTab In wRng.Tables
   
8.     ActiveDocument.Range(wTab.Cell(3, 1).Range.Start, wTab.Cell(wTab.Rows.Count, wTab.Columns.Count).Range.End).Select
   
9.     Selection.Sort , "列1", wdSortFieldNumeric, wdSortOrderAscending
   
10.     For iRow = 1 To wTab.Rows.Count
    
11.       wTab.Cell(iRow, 1).Select
    
12.       Selection.SelectRow
    
13.       Set cRng = Selection.Cells(Selection.Cells.Count).Range
    
14.       If ActiveDocument.Range(cRng.Start, cRng.End - 1) = "0" Then
    
15.         Selection.Shading.BackgroundPatternColor = wdColorGray25
    
16.       End If
    
17.     Next
    
18.   Next
    
19.   Application.ScreenUpdating = True
    
20. End Sub

复制代码

buguiize

kqbt 发表于 2016-7-20 14:40
测试下列代码前，请自行备份好原文档。

如果填充颜色之前，怎么把以前的表格填充颜色删除呢？

kqbt

buguiize 发表于 2016-7-20 17:16
如果填充颜色之前，怎么把以前的表格填充颜色删除呢？

测试下列代码前，请自行备份好原文档。

1. Sub RowsShadingGray()
   
2.   Dim wRng As Range, sRng As Range, cRng As Range, wTab As Table, iRow As Integer
   
3.   On Error Resume Next
   
4.   Application.ScreenUpdating = False
   
5.   Selection.GoTo wdGoToPage, , , "20" 'InputBox("请输入起始页码：", , 20)
   
6.   Set wRng = ActiveDocument.Range(Selection.Range.Start, ActiveDocument.Range.End - 1)
   
7.   For Each wTab In wRng.Tables
   
8.     ActiveDocument.Range(wTab.Cell(3, 1).Range.Start, wTab.Cell(wTab.Rows.Count, wTab.Columns.Count).Range.End).Select
   
9.     Selection.Shading.BackgroundPatternColor = wdColorAutomatic
   
10.     Selection.Sort , "列1", wdSortFieldNumeric, wdSortOrderAscending
    
11.     For iRow = 1 To wTab.Rows.Count
    
12.       wTab.Cell(iRow, 1).Select
    
13.       Selection.SelectRow
    
14.       Set cRng = Selection.Cells(Selection.Cells.Count).Range
    
15.       If ActiveDocument.Range(cRng.Start, cRng.End - 1) = "0" Then
    
16.         Selection.Shading.BackgroundPatternColor = wdColorGray25
    
17.       End If
    
18.     Next
    
19.   Next
    
20.   Application.ScreenUpdating = True
    
21. End Sub

复制代码

buguiize

kqbt 发表于 2016-7-21 08:15
测试下列代码前，请自行备份好原文档。

谢谢！你的代码完美的解决了我的问题。