Control and format Excel from Access

[mark curtis]

Dear all,

I can transfer records to Excel from Access ok but I am having real problems getting my head round the following:

When I transfer all my required records I now wish to insert a totals row, which should start at the row after the last with data and commence from the third column in?? Basically I need to know how to get around my range???

I also want to loop through all the text entries in column 3 and change the colour based on the text entry? Also i need the loop to only loop through the data I have transferred from Access?

I use the code below to export but need to build on this.

Any help as always much appreciated!

Dim DB As DAO.Database, Rs As DAO.Recordset
Dim i As Integer, j As Integer
Dim RsSql As String
Dim CurrentValue As Variant
Dim CurrentField As Variant
Dim Workbook As Object
Dim xlApp As Object
Dim Sheet As Object
Dim CurCell As Object
On Error GoTo Err_Command695_Click



Set DB = DBEngine.Workspaces(0).Databases(0)

'RsSql = "SELECT * FROM [Order Details] WHERE [OrderId]< 10249;"

Set Rs = DB.OpenRecordset("RORY", dbOpenDynaset)

'If recordset has no data then message and cancel
If Rs.RecordCount = 0 Then
DisplayMessage "There are no Products to export?"
Exit Sub
End If

Set xlApp = CreateObject("Excel.Application")
Set Workbook = xlApp.Workbooks.Add
Set Sheet = xlApp.ActiveWorkbook.Sheets(1)


j = 1

'Open Excel, maximise it and disable alerts.
With xlApp
.Visible = True
.WindowState = xlMaximized
.DisplayAlerts = False
.Interactive = True

' Loop through the Microsoft Access field names and create
' the Microsoft Excel labels.
For i = 0 To Rs.Fields.Count - 1
CurrentValue = Rs.Fields(i).Name
Sheet.Cells(j, i + 1).Value = CurrentValue
Next i

j = 2

' Loop through the Microsoft Access records and copy the records
' to the Microsoft Excel spreadsheet.
Do Until Rs.EOF
For i = 0 To Rs.Fields.Count - 1
CurrentField = Rs(i)
Sheet.Cells(j, i + 1).Value = CurrentField
Next i
Rs.MoveNext
j = j + 1
Loop

' Print the Microsoft Excel spreadsheet and refit all columns

.Cells.Select
.Selection.ColumnWidth = 1
.Cells.EntireColumn.AutoFit
.Cells(1, 1).Select


'Prompt user to save file
Dim Fname
Do
Fname = xlApp.GetSaveAsFilename
Loop Until Fname <> False
Workbook.SaveAs FileName:=Fname

.Range("A1:GP1").Select
.Selection.Font.Bold = True

FORMAT SHEET CODE REQUIRED

Set xlApp = Nothing

 

[Tim K.]

I cut the portions from my old code. Check them out.

When I transfer all my required records I now wish to insert a totals row, which should start at the row after the last with data and commence from the third column in?? Basically I need to know how to get around my range???

Modify the portion below to meet yours.

J = rst.RecordCount + 4
Sheet.Cells(J, 2).Value = "Total Sum"
Sheet.Cells(J, 2).Font.Bold = True


For I = 3 To rst.Fields.Count - 4
Sheet.Cells(J, I).Formula = "=SUM(C" & J - rst.RecordCount & ":C" & J - 1 & ")"
Next I

Where J is the the column you want to Sum and J - rst.RecordCount is the first column you want to start the Sum which you don't need to hardcode this part at all.

I also want to loop through all the text entries in column 3 and change the colour based on the text entry? Also i need the loop to only loop through the data I have transferred from Access?

How many conditions you want to apply to the row? You can use Conditional Formatting feature if your conditions are less than 3 or 4. Or control the colors yourself. Check the portion below.

...
intFontColor As Variant
...
For I = 0 To rst.Fields.Count - 1
CurrentField = rst(I)
Sheet.Cells(J, I + 1).Value = Nz(CurrentField)

If rst("txtDivision") = "HD" Then
intFontColor = 10485760
ElseIf rst("txtDivision") = "Corp" Then
intFontColor = 0
ElseIf rst("txtDivision") = "HSD" Then
intFontColor = 32768
ElseIf rst("txtDivision") = "Pharm" Then
intFontColor = 16711680
End If

Sheet.Cells(J, I + 1).Font.Color = intFontColor
' Sheet.Cells(J, I + 1).Font.ColorIndex is also valid

Next I
...

You can assign the colors by using Font.Color Cell's property.