Tabular Worksheets Formatted from Code

Many companies store data on customer or client accounts in an Access database and need to export that data to Excel for further analysis or distribution. For example, an insurance company might need to export data on the companies it insures, including the account number, account type, policyholder, and account executive for use by their employees in the field. The ExportAccountSummary procedure (listed as follows) exports this data, using a different approach than the previous procedure. Instead of using a preformatted Excel template, all the formatting and sizing is applied directly from VBA code, to an Excel 9 worksheet filled with Access data by the TransferSpreadsheet method:

Public Function ExportAccountSummary()

Dim strWorksheet As String Dim strWorksheetPath As String Dim appExcel As Excel.Application

Dim sht As Excel.Worksheet Dim wkb As Excel.Workbook Dim rng As Excel.Range Dim strTable As String Dim strRange As String Dim strSaveName As String Dim strPrompt As String Dim strTitle As String Dim strDefault As String

On Error GoTo ErrorHandler

Re-create table for export:

strTable = "tmakAccountSummary" DoCmd.SetWarnings False DoCmd.OpenQuery "qmakAccountSummary"

Create worksheet save name:

strWorksheetPath = GetWorksheetsPath() strWorksheet = "Account Summary"

strSaveName = strWorksheetPath & strWorksheet & ".xls" Debug.Print "Worksheet save name" & strSaveName

On Error Resume Next

Delete existing worksheet (if there is one):

Kill strSaveName

On Error GoTo ErrorHandler

Export query data to a new worksheet in Excel 9 format:

DoCmd.TransferSpreadsheet transfertype:=acExport, _ spreadsheettype:=acSpreadsheetTypeExcel9, _ TableName:=strTable, FileName:=strSaveName, _ hasfieldnames:=True

Open the newly created worksheet and insert title material:

Set appExcel = GetObject(, "Excel.Application")

appExcel.Workbooks.Open (strSaveName)

Set wkb = appExcel.ActiveWorkbook

Set sht = appExcel.ActiveSheet sht.Activate

With sht

Apply the Calibri 9 pt font to the entire worksheet:

.Range("A:F").Font.Name = "Calibri" .Range("A:F").Font.Size = 9

Apply hairline borders to the entire worksheet:

.Range("A:F").Borders xlNone .Range("A:F").Borders .Range("A:F").Borders xlContinuous .Range("A:F").Borders .Range("A:F").Borders xlAutomatic .Range("A:F").Borders xlContinuous .Range("A:F").Borders .Range("A:F").Borders xlAutomatic .Range("A:F").Borders xlContinuous .Range("A:F").Borders xlHairline .Range("A:F").Borders xlAutomatic .Range("A:F").Borders xlContinuous .Range("A:F").Borders xlHairline .Range("A:F").Borders xlAutomatic .Range("A:F").Borders xlContinuous .Range("A:F").Borders xlHairline .Range("A:F").Borders xlAutomatic .Range("A:F").Borders xlContinuous .Range("A:F").Borders xlHairline .Range("A:F").Borders xlContinuous

(xlDiagonalDown).LineStyle = _

xlDiagonalUp).LineStyle = xlNone xlEdgeLeft).LineStyle = _

xlEdgeLeft).Weight = xlHairline xlEdgeLeft).ColorIndex = _

xlEdgeTop).LineStyle = _

xlEdgeTop).Weight = xlHairline xlEdgeTop).ColorIndex = _

xlEdgeBottom).LineStyle = _

xlEdgeBottom).Weight = _

xlEdgeBottom).ColorIndex = _

xlEdgeRight).LineStyle = _

xlEdgeRight).Weight = _

xlEdgeRight).ColorIndex = _

xlInsideVertical).LineStyle = _

xlInsideVertical).Weight = _

xlInsideVertical).ColorIndex = _

xlInsideHorizontal).LineStyle = _

xlInsideHorizontal).Weight = _

xlInsideHorizontal).LineStyle = _

Set the widths of the columns:

A").ColumnWidth = 2 5 B").ColumnWidth = 15 C").ColumnWidth = 15

.Range("D:D").ColumnWidth = 20 .Range("E:E").ColumnWidth = 15 .Range("F:F").ColumnWidth = 20

Insert blank rows at top of worksheet:

.Range("1:1" .Range("1:1" .Range("1:1" .Range("1:1"

.Insert Shift .Insert Shift .Insert Shift .Insert Shift

=xlDown =xlDown =xlDown =xlDown

Format the column headings row:

With .Range("5:5") .Font.Size = 10 .Font.Bold = True

.Borders(xlEdgeTop).Weight = xlMedium .Borders(xlEdgeBottom).Weight = xlMedium .Interior.ColorIndex = 15 .Interior.Pattern = xlSolid .Interior.PatternColorIndex = xlAutomatic .RowHeight = 15 .VerticalAlignment = xlBottom .HorizontalAlignment = xlCenter .WrapText = True End With

Insert and format title text:

.Range("A1:F1" .Range("A1:F1" .Range("A1:F1" .Range("A1:F1" .Range("A1:F1" .Range("A1:F1" .Range("A1:F1"

xlNone .Range("A1:F1"

xlNone .Range("A1:F1" .Range("A1:F1" .Range("A1:F1"

xlNone .Range("A1:F1"

xlNone .Range("A1:F1"

xlNone .Range("A2:F2"

HorizontalAlignment = xlCenter VerticalAlignment = xlBottom WrapText = False Orientation = 0 ShrinkToFit = False MergeCells = True

Borders(xlDiagonalDown).LineStyle = _

Borders(xlDiagonalUp).LineStyle = _

Borders(xlEdgeLeft).LineStyle = xlNone Borders(xlEdgeTop).LineStyle = xlNone Borders(xlEdgeBottom).LineStyle = _

Borders(xlEdgeRight).LineStyle = _

Borders(xlInsideVertical).LineStyle =

HorizontalAlignment = xlCenter

A3 A3 A3 A3 A3 A3

.Range .Range Range Range Range Range xlNone .Range("A2

xlNone .Range("A2 .Range("A2 .Range("A2

xlNone .Range("A2 .Range("A2

xlNone .Range("A3 Range Range Range Range Range Range xlNone .Range("A3

xlNone .Range("A3 .Range("A3 .Range("A3

xlNone .Range("A3 .Range("A3

xlNone .Range("A4 .Range("A4

xlNone .Range("A4

xlNone .Range("A4 .Range("A4 .Range("A4 .Range("A4

xlNone .Range("A1 Range Range Range Range

F2 F2 F2 F2 F2 F2

A1 A3 A2 A1

.VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .ShrinkToFit = False .MergeCells = True

.Borders(xlDiagonalDown).LineStyle = _

.Borders(xlDiagonalUp).LineStyle = _

.Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = _

.Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = _

.HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .ShrinkToFit = False .MergeCells = True

.Borders(xlDiagonalDown).LineStyle = _

.Borders(xlDiagonalUp).LineStyle = _

.Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = _

.Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = _

.MergeCells = True .Borders(xlDiagonalDown)

.Borders(xlDiagonalUp).LineStyle = _

.Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = _

A4").Font.Size = 14 A4").Font.Bold = True ').Value = "As of " & Date ').Value = "Account Services" ').Value = "Nation-wide Summary of"

Adjust worksheet print setup and margins:

.PageSetup.PrintTitleRows = "$5:$5" .PageSetup.LeftFooter = "&F" .PageSetup.CenterFooter = "" .PageSetup.CenterHeader = "" .PageSetup.RightFooter = "Page &P" .PageSetup.Orientation = xlLandscape .PageSetup.PrintGridlines = False .PageSetup.Zoom = 90 End With

Make worksheet visible and save it:

appExcel.Application.Visible = True strPrompt = _

"Enter file name and path for saving worksheet" strTitle = "File name" strDefault = strSaveName strSaveName = InputBox(prompt:=strPrompt, _ Title:=strTitle, Default:=strDefault)

wkb.SaveAs FileName:=strSaveName, _

FileFormat:=xlWorkbookDefault appExcel.Visible = True

ErrorHandlerExit: Exit Function

ErrorHandler:

Excel is not running; open Excel with CreateObject:

Set appExcel = CreateObject("Excel.Application") Resume Next Else

& "; Description: " & Err.Description Resume ErrorHandlerExit End If

End Function

Because the workbook was created in an older format, you will see "(Compatibility Mode)" in its title bar.

The procedure starts by running a make-table query to create a table for export to Excel, then creates a save name for the worksheet, and deletes the old worksheet file, if it exists. The data in the table created by the make-table query is then exported to a new Excel worksheet, using the TransferSpreadsheet method. The new worksheet is opened and activated, and various ranges in the worksheet are formatted, applying the Calibri font, hairline borders, and appropriate column widths for each column.

I like to give tables created by make-table queries the prefix tmak, with the same base name as the query. This lets me know that a table was created by a make-table query, so I know that if I want to change it, I need to modify the query, not the table.

Next, the procedure inserts blank rows at the top of the worksheet, and title text is inserted at the top; these header lines are then formatted with a gray background and upper and lower lines. Several print setup and margin settings are done next, and finally the worksheet is saved, with an InputBox so you can modify the save name, if desired. The finished worksheet is shown in Figure 7.8.

NOTE

FIGURE 7.8

An Excel worksheet formatted in VBA code.

FIGURE 7.8

An Excel worksheet formatted in VBA code.

As a quick way to find out the syntax for various Excel commands, open an Excel worksheet, turn on the macro recorder, perform the actions, and then save the macro. Open the saved macro and copy the code to your Access procedure; with a little trimming of redundant arguments and editing to insert your variable names, it should work fine.

0 0

Post a comment