Applying Table Formatting in Excel Export

pastelrain

Registered User.
Local time
Today, 00:41
Joined
Jul 12, 2016
Messages
23
Hi,
Is there a way to apply a certain table style in access VBA for an excel export? I've tried several things and nothing seems to be working for me. Any help is much appreciated.

Here is what I have without attempting any table formatting:

Private Sub SandorFormatting_Click()
Dim Filename As String
Dim month1 As String
Dim year1 As Integer

Dim startTime As Date
startTime = Now


Dim strDirectoryPath As String
strDirectoryPath = "U:\Desktop"

Filename = strDirectoryPath & "\" & "QI_GAP_REPORT_FORMATTING" & Format$(Now(), "mm-dd-yyyy") & ".xls"
DoCmd.OpenQuery "QI_GAP_REPORT_FORMATTING"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QI_GAP_REPORT_FORMATTING", Filename, False, "Summary"
DoCmd.Close acQuery, "QI_GAP_REPORT_FORMATTING"

'///****Format excel workbook****////
' Late binding to avoid reference:
Dim xlApp As Object 'Excel.Application
Dim xlWB As Object 'Workbook
Dim xlWS As Object 'Worksheet
Dim GetBook As String


' Create the instance of Excel that we will use to open the temp book
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Open(Filename)
Set xlWS = xlWB.Worksheets("Summary")


' Format temp sheet
' ************************************************** *************************
xlApp.Range("A1").Select

Const xlLandscape As Long = 2
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
Const xlContext As Integer = -5002
Const xlDown As Integer = -4121
Const xlContinuous As Integer = 1
Const xlThin As Integer = 2

With xlWS
With .UsedRange
.borders.LineStyle = xlContinuous
.borders.ColorIndex = 0
.borders.TintAndShade = 0
.borders.Weight = xlThin
End With


'format header 90 degree
With .Range("i1:ae1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 90
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.UsedRange.Rows.RowHeight = 15
.UsedRange.Columns.AutoFit



'Disclaimer

Call .Range("A1:A10").EntireRow.insert
.Cells(1, 1).Value = "HEDIS 2017"
.Cells(2, 1).Value = "Part-C claims through May 31, 2016"
.Cells(3, 1).Value = "Part-D HRM and Part-D MA claims processed through June 16, 2016"
.Cells(4, 1).Value = "Part-D SUPD processed through June 16, 2016"
.Cells(5, 1).Value = "Part-D SUPD processed through June 16, 2016"
'.Cells(6, 1).Value = "Annual Flu Vaccine Service Dates Between July 1, 2015 to January 20, 2016"
.Cells(7, 1).Value = "The information contained in this report is intended only for the person or entity to which it is addressed and may contain CONFIDENTIAL material. If you receive this material/information in error, please contact your Account Executive and destroy the material/information."
.Cells(8, 1).Value = "Disclaimer - The information contained in this report is not a medical report, nor is it intended to be a complete record of a patient’s health information."
.Cells(9, 1).Value = "Certain information may have been intentionally excluded and the report may also contain errors. Physicians must use their professional judgment to verify this information and should not exclusively rely on this information to treat their patients."
.Cells(10, 1).Value = "Users of this report must take appropriate steps to safeguard the information contained within this report."

'Format
.Range("A1:A7").Font.Bold = True
.Range("A8:A10").Font.Italic = True

.Range("a11").EntireRow.AutoFit

With .UsedRange.Font
.Name = "Arial"
.Size = 9
End With
With .Range("A11:AE11")
.Font.Bold = True
.borders.LineStyle = xlContinuous
.borders.ColorIndex = 0
.borders.TintAndShade = 0
.borders.Weight = xlThin
End With

End With

With xlWS.PageSetup
.PrintHeadings = False
.PrintGridlines = False
.Orientation = xlLandscape
.Draft = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False ' this used to be 0 on previous printers but False works on the new Xerox
.PrintTitleRows = "$1:$11"
End With

xlWS.Range("A12").Select
xlApp.ActiveWindow.FreezePanes = True
xlWS.Range("A1").Select

'Save the file and close it
xlWB.Save

xlWB.Close

'///****End of Format excel workbook****////


MsgBox "Export complete."
End Sub
 
Hi

Have a search for information on the ListObject object. This contains the properties and methods you may be looking for.
 
Thank you. I have tried using ListObject and keep getting errors. Then I tried AccessObject and that seemed to work but then it didn't like my 'Set' statement. I can post what I tried if you think you can help. Sorry, I am new to this!
 
Post what you tried. If i can't help i am sure someone will.
 
So after more digging into my problem I found that I didn't have the Excel Object Library checked in References. Thanks so much for offering to help though, I'm sure I will have more questions!
 

Users who are viewing this thread

Back
Top Bottom