开发者

Excel 2003 VBA - Method to duplicate this code that select and colors rows

so this is a fragment of a procedure that exports a dataset from access to excel

Dim rs As Recordset

Dim intMaxCol As Integer Dim intMaxRow As Integer Dim objxls As Excel.Application Dim objWkb As Excel.Workbook Dim objSht As 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.Applica开发者_开发技巧tion
    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

see where I am looking at coloring the rows. I wanted to select and fill (with any color) every other row, kinda like some of those access reports. I can do it manually coding each and every row, but two problems: 1) its a pain 2) i don't know what the record count is before hand.

How can I make the code more efficient in this respect while incorporating the recordcount to know how many rows to "loop through"

EDIT: Another question I have is with the selection methods I am using in the module, is there a better excel syntax instead of these with selections....

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

is the only way i figure out how to accomplish this piece, but literally every other time I run this code, it fails. It says there is no object and points to the .font ....every other time? is this because the code is poor, or that I am not closing the xls app in the code? if so how do i do that?

Thanks as always!


Use conditional formatting. Here's a small piece of your code rewritten

      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

You should ask your selection question in a new question, but the answer will be: whenever you see .Select followed by With Selection, you probably don't need to select.

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


You don't need to select all range for CopyfromRecordset, just Range("A1").CopyfromRecordset rs is enought and for what i see, you could just select your data instead of all column.

For i = 2 to 6 Step 2
    With Range(Cells(1,i),Range(Cells(1,i)).End(xlDown)).Interior  
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
Next i

And for the second question @DickKusleika is right.

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜