Excel 2003 VBA - 复制此选择和着色行的代码的方法

Question

所以这是一个将数据集从 Access 到 excel 的过程的片段

Dim rs As Recordset

将 intMaxCol 调暗为整数
将 intMaxRow 调暗为整数
Dim objxls As Excel.Application
将 objWkb 调暗为 Excel.Workbook
将 objSht 调暗为 Excel.Worksheet

Set rs = CurrentDb.OpenRecordset("qryOutput", dbOpenSnapshot)

intMaxCol = rs.Fields.Count
If rs.RecordCount > 0 Then
    rs.MoveLast:    rs.MoveFirst
    intMaxRow = rs.RecordCount
    Set objxls = New Excel.Application
    objxls.Visible = True
    With objxls
        Set objWkb = .Workbooks.Add
        Set objSht = objWkb.Worksheets(1)
        With objSht
          On Error Resume Next
            .Range(.Cells(1, 1), .Cells(intMaxRow, intMaxCol)).CopyFromRecordset rs
            .Name = conSHT_NAME
            .Cells.WrapText = False
            .Cells.EntireColumn.AutoFit
            .Cells.RowHeight = 17
            .Cells.Select
                With Selection.Font
                    .Name = "Calibri"
                    .Size = 10
                End With

            .Rows("1:1").Select
                With Selection
                .Insert Shift:=xlDown
                End With
            .Rows("1:1").Interior.ColorIndex = 15
            .Rows("1:1").RowHeight = 30
            .Rows("2:2").Select
                With Selection.Interior
                .ColorIndex = 40
                .Pattern = xlSolid
                End With
             .Rows("4:4").Select
                With Selection.Interior
                .ColorIndex = 40
                .Pattern = xlSolid
                End With
             .Rows("6:6").Select
                With Selection.Interior
                .ColorIndex = 40
                .Pattern = xlSolid
                End With

              .Rows("1:1").Select
                With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = xlAutomatic
                End With
            End With
        End With
    End If

    Set objSht = Nothing
    Set objWkb = Nothing
    Set objxls = Nothing
    Set rs = Nothing
    Set DB = Nothing

End Sub

看看我在哪里给行着色。我想每隔一行选择和填充(使用任何颜色)，有点像其中一些 Access 报告。我可以手动编码每一行，但有两个问题:1)它很痛苦 2)我不知道手头的记录数是多少。

在合并记录计数以了解要“循环”多少行的同时，如何使代码在这方面更有效

编辑:我的另一个问题是我在模块中使用的选择方法，是否有更好的 excel 语法而不是这些选择......

            .Cells.Select
                With Selection.Font
                    .Name = "Calibri"
                    .Size = 10
                End With

是我弄清楚如何完成这件作品的唯一方法，但实际上每隔一次我运行这段代码时，它都会失败。它说没有对象并指向 .font ....每隔一次？这是因为代码很差，还是我没有在代码中关闭 xls 应用程序？如果是这样，我该怎么做？

一如既往的感谢!

Answer 1

使用条件格式。这是您重写的一小部分代码

      On Error Resume Next
        With .Range(.Cells(1, 1), .Cells(intMaxRow, intMaxCol))
            .CopyFromRecordset rs
            .FormatConditions.Add xlExpression, , "=MOD(ROW(),2)=1"
            With .FormatConditions(1)
                .Interior.Color = vbYellow
            End With
        End With

您应该在一个新问题中询问您的选择问题，但答案将是:每当您看到 .Select 后跟 With Selection 时，您可能不需要选择。

With Cells.Font
    .Name = "Calibri"
    .Size = 10
End With