[AccessD] Report to Excel_

Mark A Matte markamatte at hotmail.com
Wed May 9 09:26:12 CDT 2007


Thanks John,

I got the formatting the way I needed it...I used the report to determine 
what order the columns would be in...and then changed the font,color,etc in 
excel.

Now I just need to get the sheets into a single workbook.

Thanks,

Mark



>From: "John Skolits" <askolits at ot.com>
>Reply-To: Access Developers discussion and problem 
>solving<accessd at databaseadvisors.com>
>To: "'Access Developers discussion and problem 
>solving'"<accessd at databaseadvisors.com>
>Subject: Re: [AccessD] Report to Excel_
>Date: Tue, 8 May 2007 18:02:47 -0400
>
>Mark,
>
>I've been kind-of following this thread and thought I'd share my code with
>you.
>It may not help you with what you're doing, but it's a slightly different
>approach.
>I use an Excel sheet as a template to do some of my formatting. I open it,
>use the CopyFromRecordset function to paste the data into Excel, then do a
>"Save AS". The nice thing about the template is you can make a formatting
>change to it instead of having to do it in the code. There will probably be
>some need to still do some vba-code formatting of the spreadsheet, but this
>can cut down on some of the coding.
>
>Note: You can't paste the code below and run it because I cut it up a 
>little
>to make it more succinct, but it may give you some other ideas. I also have
>some error trapping codes at the end that may help.
>
>John
>----
>
>
>Private Sub btnExportToExcelX()
>
>On Error GoTo Err_btnExportToExcel
>
>Dim objXLBook As Excel.Workbook
>Dim rsFinalBidQuery As dao.Recordset, varResults As Variant
>Dim objXLRange As Excel.Range, objXLApp As Excel.Application
>Dim objResultsSheet As Excel.Worksheet
>Dim intMaxCol As Integer
>Dim intMaxRow As Integer
>Dim strExportFilename As String, strFullXLTemplateFilename As String
>
>strExportFilename =TestWorkbook.xls"
>strFullXLTemplateFilename = "c:\ExcelTemplateFile.xls"
>
>Set objXLBook = GetObject(strFullXLTemplateFilename)
>Set objXLApp = objXLBook.Parent
>Set objResultsSheet = objXLBook.Worksheets(1)
>
>Set rsFinalBidQuery = CurrentDb().OpenRecordset("qryToExport")
>     rsFinalBidQuery.MoveLast
>    rsFinalBidQuery.MoveFirst
>
>    '*Store the data in the worksheet
>    intMaxCol = rsFinalBidQuery.Fields.Count
>       If rsFinalBidQuery.RecordCount > 0 Then
>         intMaxRow = rsFinalBidQuery.RecordCount
>         With objXLApp
>           With objResultsSheet
>             .Range(.Cells(11, 2), .Cells(11 + intMaxRow, 2 +
>intMaxCol)).CopyFromRecordset rsFinalBidQuery
>           End With
>         End With
>       End If
>
>rsFinalBidQuery.Close
>
>'Add some values to specific defined cells
>objResultsSheet.Range("PartNum").Value = "PN# 1234"
>objResultsSheet.Range("PartDesc").Value = "Description"
>
>objXLBook.Parent.Windows(objXLBook.Name).Visible = True
>
>'Save it as a new name
>objXLBook.SaveAs strExportFilename
>objXLApp.Visible = True
>
>' Release the object variable
>Set objXLBook = Nothing
>
>BuildXLBidReport_EXIT:
>Set rsFinalBidQuery = Nothing
>
>DoCmd.Hourglass False
>DoCmd.Echo True
>
>Exit Sub
>
>BuildXLBidReport_ERR:
>
>'If user picks to cancel the opening of the worksheet because of the excel
>macro message this error occurs
>If Err = 287 Then Resume BuildXLBidReport_EXIT
>
>If Err = 70 Then
>     MsgBox " Make sure this worksheet **" & strExportFilename & "** isn't
>alreday open.", 64, "Excel Sheet Open"
>     Resume BuildXLBidReport_EXIT
>End If
>If Err = 1004 Then
>     MsgBox " Make sure this worksheet **" & strExportFilename & "** isn't
>alreday open.", 64, "Excel Sheet Open"
>     objXLBook.Application.Quit
>     ' Release the object variable
>     Set objXLBook = Nothing
>     Resume BuildXLBidReport_EXIT
>End If
>
>'Display the error
>
>       Dim strCallingObject As String
>       strCallingObject = "BuildXLBidReport" & "  " &
>Application.CurrentObjectName & " Line: " & Erl
>       lg_VarTemp = lbf_ErrorMessage(Err, Error, strCallingObject)
>       Resume BuildXLBidReport_EXIT
>
>     Dim oApp As Object
>
>     Set oApp = CreateObject("Excel.Application")
>     oApp.Visible = True
>     'Only XL 97 supports UserControl Property
>     On Error Resume Next
>     oApp.UserControl = True
>
>Exit_btnExportToExcel:
>     Exit Sub
>
>Err_btnExportToExcel:
>     MsgBox Err.Description
>     Resume Exit_btnExportToExcel
>
>End Sub
>
>
>
>--
>AccessD mailing list
>AccessD at databaseadvisors.com
>http://databaseadvisors.com/mailman/listinfo/accessd
>Website: http://www.databaseadvisors.com

_________________________________________________________________
Like the way Microsoft Office Outlook works? You’ll love Windows Live 
Hotmail. 
http://imagine-windowslive.com/hotmail/?locale=en-us&ocid=TXT_TAGHM_migration_HM_mini_outlook_0507




More information about the AccessD mailing list