Hi,
I am using a public function that I found called send2Excel that exports one of my access tables to a new excel workbook. It even came with some formatting options.
I thought I could copy/paste more VBA from Excel into this function in order to further design/cleanup this new worksheet. I have gotten through most of converting what is needed in order to make it work in access during the export, but I keep getting stuck at either
"424 object required" or
"unable to set the horizontal alignment of class range".
Im pretty sure the first wants me to use the Excel reference, but I want to use late binding to avoid any issues with different versions.
I looked up the later, and I see its a common issue but I seem to keep going in a loop. Can someone please point me in the right direction?
Pretty sure the errors pertain to this part on xlCenter, but xlCenter is already declared. I also tried changing the xlCenter here to -4108 with no luck:
Full code for function:
I am using a public function that I found called send2Excel that exports one of my access tables to a new excel workbook. It even came with some formatting options.
I thought I could copy/paste more VBA from Excel into this function in order to further design/cleanup this new worksheet. I have gotten through most of converting what is needed in order to make it work in access during the export, but I keep getting stuck at either
"424 object required" or
"unable to set the horizontal alignment of class range".
Im pretty sure the first wants me to use the Excel reference, but I want to use late binding to avoid any issues with different versions.
I looked up the later, and I see its a common issue but I seem to keep going in a loop. Can someone please point me in the right direction?
Pretty sure the errors pertain to this part on xlCenter, but xlCenter is already declared. I also tried changing the xlCenter here to -4108 with no luck:
Code:
.Range("A1:D1").Select
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Selection.MergeFull code for function:
Code:
Public Function Send2Excel(frm As Form, Optional strSheetName As String)
' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to
Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim intCount As Integer
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107
On Error GoTo err_handler
Set rst = frm.RecordsetClone
Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True
Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 34)
End If
xlWSh.Range("A1").Select
Do Until intCount = rst.Fields.Count
ApXL.ActiveCell = rst.Fields(intCount).Name
ApXL.ActiveCell.Offset(0, 1).Select
intCount = intCount + 1
Loop
rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select
' This is included to show some of what you can do about formatting.
' You can comment out or delete any of this that you don't want to
' use in your own export.
With ApXL.Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
ApXL.Selection.Font.Bold = False
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
' selects all of the cells
ApXL.ActiveSheet.Cells.Select
' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
' selects the first cell to unselect all cells
xlWSh.Range("A1").Select
'Format macro
'Const xlCenter As Long = -4108
With ApXL
.Columns("A:A").Select
.Selection.Delete Shift:=xlToLeft
.Columns("D:D").Select
.Selection.Delete Shift:=xlToLeft
.Selection.ColumnWidth = 150
.Columns("E:E").Select
.Selection.Delete Shift:=xlToLeft
.Columns("A:A").Select
.Selection.NumberFormat = "mm/dd/yy;@"
.Columns("B:B").Select
.Selection.NumberFormat = "h:mm;@"
.Columns("A:D").Select
With ApXL.Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("A1").Select
.ActiveCell.FormulaR1C1 = "DATE"
.Range("B1").Select
.ActiveCell.FormulaR1C1 = "TIME"
.Range("C1").Select
.ActiveCell.FormulaR1C1 = "BADGE"
.Range("D1").Select
.ActiveCell.FormulaR1C1 = "RESPONSE"
.Rows("1:1").Select
.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("A1:D1").Select
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Selection.Merge
.Range("A2:D2").Select
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Selection.Merge
.Range("A3:D3").Select
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Selection.Merge
.Range("A4:D4").Select
With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Selection.Merge
.Range("A1:D1").Select
.ActiveCell.FormulaR1C1 = "HORRY COUNTY POLICE - AIRPORT DIVISION"
.Range("A2:D2").Select
.ActiveCell.FormulaR1C1 = "POLICE BLOTTER"
.Range("A3:D3").Select
.ActiveCell.FormulaR1C1 = "=TODAY()"
.Range("A3:D3").Select
.Selection.Copy
.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("A3:D3").Select
.Selection.NumberFormat = "mmmm yyyy"
.Range("A1:D3").Select
.Selection.Font.Bold = True
.Range("A5").Select
.ActiveSheet.ListObjects.Add(xlSrcRange, .Range("$A$5:$D$65"), , xlYes).Name = _
"Table1"
.Range("Table1[#All]").Select
.ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium4"
.ActiveWorkbook.Worksheets("Blotter").ListObjects("Table1").Sort.SortFields. _
Clear
.ActiveWorkbook.Worksheets("Blotter").ListObjects("Table1").Sort.SortFields.Add _
Key:=.Range("Table1[DATE]"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ApXL.ActiveWorkbook.Worksheets("Blotter").ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.Range("A1:D1").Select
.Application.PrintCommunication = False
With ApXL.ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
.Application.PrintCommunication = True
.ActiveSheet.PageSetup.PrintArea = ""
.Application.PrintCommunication = False
With ApXL.ActiveSheet.PageSetup
.LeftHeader = "&14HORRY COUNTY POLICE"
.CenterHeader = "&14AIRPORT DIVISION"
.RightHeader = "&14POLICE BLOTTER"
.LeftFooter = ""
.CenterFooter = "&14HORRY COUNTY POLICE"
.RightFooter = ""
.LeftMargin = .Application.InchesToPoints(0.1)
.RightMargin = .Application.InchesToPoints(0.1)
.TopMargin = .Application.InchesToPoints(0.75)
.BottomMargin = .Application.InchesToPoints(0.75)
.HeaderMargin = .Application.InchesToPoints(0.25)
.FooterMargin = .Application.InchesToPoints(0.25)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 56
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
.Application.PrintCommunication = True
'Finish Send2Excel
rst.Close
Set rst = Nothing
Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function
End With
End Function
