Question : Auto Formatting Excel

I have code to export 2 query result to Excel and it works fine. I did some formatting but I need to do more. I need some code to do the following:

1. Rename Sheet 1 to "Roster"
2. Delete Sheet2 and Sheet 3
3. Set the Zoom to 80%
4. Page Orientation to Landscape
5. Fit to page width
6. Set all margins to .5
7. Set Print Area to columns A though N

Any help is appreciated.
Code Snippet:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
Dim xlObj As Object
    Dim rs As DAO.Recordset
    Dim j As Integer
    Dim rowCnt As Integer
    Dim curRow As Integer
    Dim filePathName As String
    Dim tabName As String
    Dim db As Database
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Set db = CurrentDb
    
    filePathName = Me!txtFolder & Me!txt_Title & Me!txt_Title_Ext

    Set xlObj = CreateObject("Excel.application")

        xlObj.Workbooks.Add
        
        With xlObj
            .Worksheets(1).Select

            Set qdf = db.QueryDefs("qry_ExportRoster_Department_Staff_Sums3A")
            For Each prm In qdf.Parameters
            prm.Value = Eval(prm.Name)
            Next prm
            Set rs = qdf.OpenRecordset(dbOpenDynaset)
            
            For j = 0 To rs.Fields.Count - 1
                .Cells(1, j + 1).Value = rs(j).Name
            Next
            .Range("A2").CopyFromRecordset rs

            rowCnt = .Worksheets(1).UsedRange.Rows.Count
            Set qdf = db.QueryDefs("qry_ExportRoster_Department_Staff_Sums3")
            For Each prm In qdf.Parameters
            prm.Value = Eval(prm.Name)
            Next prm
            
            Set rs = qdf.OpenRecordset(dbOpenDynaset)
            
            For j = 0 To rs.Fields.Count - 1
                .Cells(rowCnt + 3, j + 1).Value = rs(j).Name
            Next
            .Range("A" & rowCnt + 4).CopyFromRecordset rs
            rowCnt = .Worksheets(1).UsedRange.Rows.Count

            .Rows("1:1").RowHeight = 16
            .Rows("5:5").RowHeight = 41
            .Cells.Font.Name = "Arial"
            .Cells.Font.Size = 10
            .Range("A1:D1").Interior.ColorIndex = 15
            .Range("A5:N5").Interior.ColorIndex = 15
            .Rows("1:1").WrapText = True
            .Rows("5:5").WrapText = True
            
            .Columns("A").HorizontalAlignment = xlCenter
            .Columns("B:C").HorizontalAlignment = xlLeft
            .Columns("D:F").HorizontalAlignment = xlCenter
            .Columns("G:J").HorizontalAlignment = xlRight
            .Columns("K:M").HorizontalAlignment = xlCenter
            .Columns("N").HorizontalAlignment = xlLeft
            
            .Rows("1:1").HorizontalAlignment = xlCenter
            .Rows("1:1").VerticalAlignment = xlCenter
            .Rows("5:5").HorizontalAlignment = xlCenter
            .Rows("5:5").VerticalAlignment = xlCenter

            'Set Borders for 1st Row
            With .Range("A1:D1").Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A1:D1").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A1:D1").Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A1:D1").Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A1:D1").Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            
            'Set Borders for 5th Row
            With .Range("A5:N5").Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A5:N5").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A5:N5").Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A5:N5").Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A5:N5").Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With

            'Set Column Formats
            .Columns("A").NumberFormat = "###0"
            .Columns("D").NumberFormat = "###0"
            .Columns("E:F").NumberFormat = "0.00"
            .Columns("G:J").NumberFormat = "$#,##0.00"
            .Columns("L").NumberFormat = "0.00"
            .Columns("M").NumberFormat = "mm/dd/yyyy"
            
            'Set Column Widths
            .Columns("A").ColumnWidth = 11
            .Columns("B").ColumnWidth = 33
            .Columns("C").ColumnWidth = 25
            .Columns("D").ColumnWidth = 12
            .Columns("E:F").ColumnWidth = 10
            .Columns("G:I").ColumnWidth = 14
            .Columns("J:L").ColumnWidth = 10
            .Columns("M").ColumnWidth = 11
            .Columns("N").ColumnWidth = 24
            

            .ActiveWorkbook.SaveAs filePathName
        End With

        xlObj.Quit
        rs.Close

Answer : Auto Formatting Excel

This should do it:

        With xlObj
            .Sheets("Sheet1").Select
            .Sheets("Sheet1").Name = "Roster"
            .Sheets("Sheet2").Select
            .ActiveWindow.SelectedSheets.Delete
            .Sheets("Sheet3").Select
            .ActiveWindow.SelectedSheets.Delete
            .ActiveWindow.Zoom = 80
        End With
       
        With xlObj.ActiveSheet.PageSetup
            .LeftMargin = xlObj.Application.InchesToPoints(0.5)
            .RightMargin = xlObj.Application.InchesToPoints(0.5)
            .TopMargin = xlObj.Application.InchesToPoints(0.5)
            .BottomMargin = xlObj.Application.InchesToPoints(0.5)
            .HeaderMargin = xlObj.Application.InchesToPoints(0.5)
            .FooterMargin = xlObj.Application.InchesToPoints(0.5)
            .Orientation = xlLandscape
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With

As for setting the print area to columns A thru N ... you could try this:

        xlObj.ActiveSheet.PageSetup.PrintArea = "$A:$N"

I didn't have time to test it out though.

Hope that helps.
Random Solutions  
 
programming4us programming4us