export Access query to Excel 2

[hellohello1]

What is the code to export Access data to Excel if the query I want to send to Excel is a crosstab query that has 2 parameters? (The parameters are 2 values from two combo boxes on my form).
One parameter is called [Forms]![frmEscalationReports]![cboEscalation] and is a long integer.
The other parameter is called [Forms]![frmEscalationReports]![cboDate] and is a date.

I am trying to export to Excel with 2 special formatting needs in Excel:
--Data, Filter, AutoFilter is turned on for my columns in Row 1.
--My column names in Row 1 are turned vertically. In other words, the Orientation is 90 degrees. (Format, Cells, Alignment tab, Orientation section).

Thanks!!!

 

[randy700]

Perhaps you need the TransferSpreadsheet method.


Randy

 

[hellohello1]

thanks for writing.

but with TransferSpreadsheet, can I set the formatting needs in Excel: the auto filter and the vertical column headers?

thanks!

 

[dhookom]

I think you will need to use automation to create or open an Excel file, push in the records, and then perform the other formatting.

Duane
Hook'D on Access
MS Access MVP

 

[SkipVought]

Check out the VBA Help on CreateObject and GetObject. There are some good code examples.

To find out what code in Excel to do the formatting, open Excel, turn on your macro recorder and record the processes. That code can be modified, by referencing the Excel Objects.

Post back with your code for further help.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[hellohello1]

that was fun! Thanks for pointing out the Record Macro! teach a man to fish...

Everything regarding formatting in Excel works when I test it on a simple query. It's cool. I was able to freeze panes, make columns vertical, set widths, delete extra sheets, etc.

But when I try it with my crosstab query that has 2 parameters, i'm getting 'Too few parameters. Expected 2'

Here is the code:

Private Sub Command28_Click()
Send2Excel ("Qry KPI Detail Report- Escalation Summary")
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Send2Excel
' Author : Bob Larson
' Date : 5/25/2008
' Purpose : Send any single recordset form to Excel. This will not work with
' subforms.
' Use : You may freely use this code as long as the author information in
' this header remains intact
'---------------------------------------------------------------------------------------

Public Function Send2Excel(qry As String, Optional strSheetName As String)
' qry is the name of the query you want to send to Excel
' strSheetName is the name of the sheet you want to name it to

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As Field
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler

Set rst = CurrentDb.OpenRecordset(qry)
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 34)
End If
xlWSh.Range("A1").Select


For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next

rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
' formatting for the first row (1:1)
With ApXL.selection.Font
.Name = "Arial"
.Size = 10
.Bold = True
End With

With ApXL.selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
End With

' selects all of the cells
ApXL.ActiveSheet.Cells.Select

' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit

'make the column headers vertical (90 degrees)
xlWSh.Range("1:1").Select
ApXL.selection.Orientation = 90

'adjusts the column size for column 2 and 3 and row height for row 1.
xlWSh.Columns("B:B").ColumnWidth = 41
xlWSh.Columns("C:C").ColumnWidth = 19.43
xlWSh.Rows("1:1").RowHeight = 73.5

'adds the autofilter to the first row
ApXL.selection.AutoFilter

'set freeze panes
xlWSh.Rows("2:2").Select
ApXL.ActiveWindow.FreezePanes = True

'delete Sheet2 and Sheet3
xlWBk.Sheets(Array("Sheet2", "Sheet3")).Select
xlWBk.Sheets("Sheet3").Activate
ApXL.ActiveWindow.SelectedSheets.Delete

' selects the first cell to unselect all cells
xlWSh.Range("A1").Select

rst.Close
Set rst = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function

End Function

 

[SkipVought]

Where's your crosstsab sql?

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[hellohello1]

It is:

PARAMETERS [Forms]![frmEscalationReports]![cboEscalation] Long, [Forms]![frmEscalationReports]![cboDate] DateTime;
TRANSFORM IIf(First([CodeGrouping]) Is Null,Count(tblEscalationReportsDetail![Criteria Code]),IIf(First([CodeGrouping]) In ("Dev Underrun","Dev Overrun"),First(FormatPercent([dev cost Variance],1)),IIf(First([codeGrouping]) In ("Maint Underrun","Maint Overrun"),First(FormatPercent([Maint Cost Variance],1)),Null))) AS Expr2
SELECT tblEscalationReports.ReportName, [Project Status Survey].ADDomain, [Project Status Survey].ProjectName, [Project Status Survey].[Project ID], [Project Status Survey Budget].SizeClass, [Project Status Survey].[As-Of Date]
FROM ((((([KPI Rating Criteria] LEFT JOIN tblEscalationReportsDetail ON [KPI Rating Criteria].[Criteria Code] = tblEscalationReportsDetail.[Criteria Code]) LEFT JOIN tblEscalationReports ON tblEscalationReportsDetail.ReportIDLink = tblEscalationReports.ReportID) RIGHT JOIN [KPI Rating Rationale] ON [KPI Rating Criteria].[Criteria Code] = [KPI Rating Rationale].[Criteria Code]) INNER JOIN [Project Status Survey] ON ([KPI Rating Rationale].[Project ID] = [Project Status Survey].[Project ID]) AND ([KPI Rating Rationale].[As-of-Date] = [Project Status Survey].[As-Of Date])) INNER JOIN [Project Status Survey Budget] ON ([Project Status Survey].[Project ID] = [Project Status Survey Budget].[Project ID]) AND ([Project Status Survey].[As-Of Date] = [Project Status Survey Budget].[As-Of Date])) LEFT JOIN qryCostVariance ON ([Project Status Survey].[As-Of Date] = qryCostVariance.[As-Of Date]) AND ([Project Status Survey].[Project ID] = qryCostVariance.[Project ID])
WHERE (((tblEscalationReportsDetail.ReportIDLink)=[Forms]![frmEscalationReports]![cboEscalation]) AND (([Project Status Survey].[As-Of Date])=[Forms]![frmEscalationReports]![cboDate]))
GROUP BY tblEscalationReports.ReportName, [Project Status Survey].ADDomain, [Project Status Survey].ProjectName, [Project Status Survey].[Project ID], [Project Status Survey Budget].SizeClass, [Project Status Survey].[As-Of Date]
ORDER BY [Project Status Survey].ADDomain, [Project Status Survey].ProjectName, [Project Status Survey].[Project ID], IIf([CodeGrouping] Is Null,tblEscalationReportsDetail![Criteria Code],[CodeGrouping])
PIVOT IIf([CodeGrouping] Is Null,tblEscalationReportsDetail![Criteria Code],[CodeGrouping]);

 

[PHV]

Replace this:
Set rst = CurrentDb.OpenRecordset(qry)
with this:
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Set db = CurrentDb
Set qdf = db.QueryDefs(qry)
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[hellohello1]

Wow! that works perfectly!!! Thank you so much to PHV and to Skip!

Two more questions:

1). I'm trying to set the orientation to Landscape. I ran the macro and got the code. In Access, I typed: ApXL.ActiveSheet.PageSetup.Orientation = xlLandscape
but i'm getting 'unable to set the orientation property of the PageSetup class'. What am I doing wrong?


2). Also, is there a way to create a table border grid only where there is data in Excel? I ran the Excel macro and got the code below, but the range will vary depending on how much data is returned, the data range won't always end at K19.

This is from the macro:

Range("A1:K19").Select
Range("K19").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Thanks!

 

[SkipVought]

    With Range("A1").CurrentRegion
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

tyr

ApXL.ActiveSheet.PageSetup.Orientation = 2

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[hellohello1]

Thanks!

The page orientation works great.

For the table border, I had to add 'xlWsh' to your code:
With xlWSh.Range("A1").CurrentRegion
because I was getting 'Sub or function not defined'.

But now I'm getting 'Application-defined or object- defined error'.

Thanks again,

 

[SkipVought]

error on WHAT statement?

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[hellohello1]

To troubleshoot, I commented out all the code except:
With xlWSh.Range("A1").CurrentRegion
End With
and I didn't get an error.

Then I commented out all the code except:
With xlWSh.Range("A1").CurrentRegion
.Borders(xlDiagonalDown).LineStyle = xlNone
End With
and then I got the error.

So I guess the error is due to
.Borders(xlDiagonalDown).LineStyle = xlNone

Thanks!

 

[SkipVought]

You probably do not have a reference set in Tools > References to a Microsoft Excel Object Library. So you cannot use Excel Constants like xlLandscape, or xlNone.

So either add that reference, or open Excel and use the Object Browser to discover the numeric value for each Excel Constant. The latter is what I did to solve the page setup problem you were having.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[hellohello1]

You are amazing. Checking the reference for Excel 11.0 Object Library was all it took!!!!


I am having so much fun formatting the page using macros!

I'm just stuck on making Row 1 gray for the columns where there is data. I tried to copy what you had in selecting only current data in making the table grid. But my code below makes *all* the columns of Row 1 gray, starting from A to ZZZ etc.

'make Row 1 gray
xlWSh.Range("A1").CurrentRegion
ApXL.Selection.Interior.ColorIndex = 15
ApXL.Selection.Interior.Pattern = xlSolid

What am I doing wrong?

Thanks again for all your help. You are very smart and very nice.

 

[SkipVought]

    'make Row 1 gray
     With [b]YourExcelApplicationObject[/b].intersect(xlWSh.Range("A1").CurrentRegion, xlWSh.Rows(1))
        .Interior.ColorIndex = 15
        .Interior.Pattern = xlSolid
     End with

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[hellohello1]

Perfect!!!!!!!!!!!!!

thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you thank you

 

[SkipVought]

Great!

How are the cherry blossoms up there in DC?

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}