[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Format Excel Rows and Columns on Export

Posted on 2009-04-27
3
Medium Priority
?
1,062 Views
Last Modified: 2013-11-28
I am using the below code to export my data to excel. I'd like to be able to set the Excel row height and column width. Any ideas how to go about this?
Case 3  ' if Export report is selected then export to Excel
                   DoCmd.OpenReport strDoc, acViewPreview, , strWhere, acIcon
                   Reports(strDoc).FilterOn = True
                   RunCommand acCmdOutputToExcel
                   DoCmd.close acReport, strDoc

Open in new window

0
Comment
Question by:dglover
  • 3
3 Comments
 
LVL 18

Expert Comment

by:jmoss111
ID: 24247324
The only way that I know to do this is to build the .xls file via automation using vba.
0
 
LVL 18

Expert Comment

by:jmoss111
ID: 24247333
Your formatting vba can be obtained by recording a macro while you're formatting an excel file. The vba in the macro can be modified and used in Excel automation in an Access module.
0
 
LVL 18

Accepted Solution

by:
jmoss111 earned 2000 total points
ID: 24247356
The attached code snippet will build a formatted excel file with freeze set on second row with an autofilter, icon in top row with height and width set, etc
Public Sub BuildSQLPaymentRecordsetForXL()
Dim TSM As Double
Dim ThsDay As String
Dim ThisDay As String
Dim intMaxCol As Integer
Dim intMaxRow As Long
Dim objXL As Object
Dim objWkb As Object
Dim objSht As Object
Dim db As dao.Database
Dim rs As dao.Recordset
 
        TSM = Format([Timer], 0)
        ThisDay = Date$
        ThsDay = Right([ThisDay], 4) & Left([ThisDay], 2) & Mid([ThisDay], 4, 2)
        ThsDay = ThsDay & "_" & TSM
Set db = CurrentDb
        
CurrentData:
   
        
            Set rs = db.OpenRecordset("SELECT * from qrsExcelFromPassThru;", dbOpenDynaset)
FormatXLS:
        intMaxCol = rs.Fields.Count
            If rs.RecordCount = 0 Then GoTo NoRows
            If rs.RecordCount > 0 Then
               
               Set objXL = CreateObject("Excel.Application")
               With objXL
                   .Visible = False
                   Set objWkb = .Workbooks.Add
                   Set objSht = objWkb.Worksheets(1)
                                          
                       With objSht
                          .range(.cells(3, 1), .cells(intMaxRow, _
                          intMaxCol)).CopyFromRecordset rs
                       End With
               End With
            End If
          objSht.cells(2, 1).formular1c1 = "VendorName"
          objSht.cells(2, 2).select
          objSht.cells(2, 2).formular1c1 = "PaymentDate"
          objSht.cells(2, 3).select
          objSht.cells(2, 3).formular1c1 = "InvoiceNumber"
          objSht.cells(2, 4).select
          objSht.cells(2, 4).formular1c1 = "InvoiceAmt"
          objSht.cells(2, 5).select
          objSht.cells(2, 5).formular1c1 = "InvoiceDate"
          objSht.cells(2, 6).select
          objSht.cells(2, 6).formular1c1 = "PaymentNumber"
          objSht.cells(2, 7).select
          objSht.cells(2, 7).formular1c1 = "ERP"
          objSht.cells(2, 8).select
          objSht.cells(2, 8).formular1c1 = "Location"
          objSht.cells(2, 9).select
          objSht.cells(2, 9).formular1c1 = "VendorNo"
          objSht.cells(2, 10).select
          objSht.cells(2, 10).formular1c1 = "PaymentAmt"
          objSht.cells(2, 11).select
          objSht.cells(2, 11).formular1c1 = "AmtPaid"
          objSht.cells(2, 12).select
          objSht.cells(2, 12).formular1c1 = "AccountName"
          objSht.cells(2, 13).select
          objSht.cells(2, 13).formular1c1 = "PaySite"
          objSht.cells(2, 14).select
          objSht.cells(2, 14).formular1c1 = "PayAddress"
          objSht.cells(2, 15).select
          objSht.cells(2, 15).formular1c1 = "VoidDate"
          objSht.cells(2, 16).select
          objSht.cells(2, 16).formular1c1 = "Curr"
          
          
          
          
            '================================================================================
            objSht.range("A1").select
            objSht.Rows("1:1").RowHeight = 51
            objSht.Columns("A:A").ColumnWidth = 17.57
            objSht.Pictures.Insert("J:\Acct\IC_Data\Graphics\red.jpg").select
            objSht.Columns("A:A").ColumnWidth = 9.71
            objSht.Columns("A:A").ColumnWidth = 9.43
            objSht.Columns("D:D").NumberFormat = "#,##0.00"
            objSht.Columns("J:J").NumberFormat = "#,##0.00"
            objSht.Columns("K:K").NumberFormat = "#,##0.00"
            objSht.range("B1").select
            objSht.cells(1, 2).formular1c1 = "Payments"
            With objSht.cells(1, 2).Characters(start:=1, Length:=8).Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 14
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                '.Underline = xlUnderlineStyleNone
                '.ColorIndex = xlAutomatic
            End With
            '================================================================================
            objSht.Rows("2:2").AutoFilter
            
            objSht.Rows("2:2").Interior.ColorIndex = 19
            'objSht.Rows("2:2").Interior.Pattern = solid
            
            
            objSht.Rows("3:3").select
     '
            objXL.ActiveWindow.FreezePanes = True
          
         With objXL
            .Sheets("Sheet1").select
            .Sheets("Sheet1").Name = "Payments"
            'objXL.Sheets("Sheet2").Delete
            'objXL.Sheets("Sheet3").Delete
        End With
 
         objWkb.SaveAs ("Payments_" & ThsDay)
         objWkb.Close
         Set objSht = Nothing
         Set objWkb = Nothing
         GoTo DestroyObjects
         
         
NoRows:
         MsgBox ("No data returned")
 
'=================================================================================================================================
DestroyObjects:
'=================================================================================================================================
 
    'objXL.Quit
    Set objXL = Nothing
    Set rs = Nothing
    
    Set db = Nothing
    
    DoCmd.SetWarnings False
 
 
End Sub

Open in new window

0

Featured Post

Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

834 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question