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.
精彩评论