CODEWITHSUNDEEP
excelinteropexcel-2007vba
JimS-CLT
JimS-CLT

Reputation: 675

Excel Interop formatting

Using Access 2007 vba addressing an Excel 2007 workbook ("WB")....

This routine adds a worksheet to an existing and open excel workbook, then adds the rows of a recordset to the sheet. It's quite messy for now, I'm setting it up to create several sheets, all looking at the same data in different ways.

I have succeeded in posting the rows, but now I want to format them a little better to avoid confusing Excel-ignorant target users. I want to change the color of the header cells, and I want to set the columns to "autofit".

Can anyone help?

Sub SummarySheets(WB As Excel.WorkBook, TempTableName As String)
Const SummarySheetName As String = "Timesheet Summaries"
Const SummaryQueryName As String = "qrySATempSummarybyWO"
Const SummaryTitleRow As Integer = 1


Dim xlSumSht As Excel.Worksheet
If SheetExists(WB, SummarySheetName) Then
    WB.Sheets(SummarySheetName).Delete
End If
Set xlSumSht = WB.Sheets.Add(After:=WB.Sheets(WB.Sheets.count))
xlSumSht.NAME = SummarySheetName
xlSumSht.Activate

Dim intRow As Integer
Dim intCol As Integer
Dim intStartRow As Integer
Dim strSQL As String
Dim strQry As String

Dim rstSummary As DAO.Recordset

strQry = CurrentDbC.QueryDefs(SummaryQueryName).SQL
strSQL = Replace(strQry, "tblStaffAugTrans", "[" & TempTableName & "]")

Set rstSummary = CurrentDbC.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges + dbFailOnError)
If rstSummary.EOF = False Then
    intRow = SummaryTitleRow
    For intCol = 1 To rstSummary.Fields.count
        xlSumSht.Cells(intRow, intCol).Value = rstSummary.Fields(intCol - 1).NAME
    Next intCol
End If
While rstSummary.EOF = False
    intRow = intRow + 1
    For intCol = 1 To rstSummary.Fields.count
        xlSumSht.Cells(intRow, intCol).Value = rstSummary.Fields(intCol - 1).Value
    Next intCol
    rstSummary.MoveNext
Wend
For intCol = 1 To rstSummary.Fields.count
    'xlSumSht.Columns.EntireColumn(, intCol).AutoFit
Next intCol

rstSummary.Close

End Sub

Upvotes: 0

Views: 360

Answers (1)

markblandford
markblandford

Reputation: 3193

Something like this should do the job. This will simply set the headings to have a Yellow interior colour and will auto-fit the columns.

With xlSumSht.Range(Cells(SummaryTitleRow, 1), Cells(SummaryTitleRow, rstSummary.Fields.Count))
    .Interior.Color = vbYellow
    .EntireColumn.AutoFit
End With

Upvotes: 1

Related Questions