roelandwatteeuw
Board Regular
- Joined
- Feb 20, 2015
- Messages
- 87
- Office Version
- 365
- Platform
- Windows
Hi all
Situation:
I'm extracting an Access query to Excel with VBA.
In this excel, I let VBA do a few things like formatting the cells.
I made the code work and the sheet looks good, but I'm not sure if it's all versions proove.
For my code I have put a check in the references at 'Microsoft Excel 16.0 Object Library'
And this all works.
If I uncheck the reference, VBA returns errors.
No problem so far... just keep it on!?
Problem:
But what if an other user doesn't have it checked? Or has an older version of the Object Library?
It would give an error for him, wouldn't it?
I read things about early and late binding, where the early binding could give problems with this.
So I tried to change it to a late binding (using Objects).
When unchecking the Excel Object Library box, the code will still return errors.
Did I do something wrong? (Probably!)
Extra info:
sQuery = Name from the Query
sPath = Filepath where the sheet needs to be added
Both come from other sub
This is my code:
Many thanks for helping me clearing this out!
Greetz
R
Situation:
I'm extracting an Access query to Excel with VBA.
In this excel, I let VBA do a few things like formatting the cells.
I made the code work and the sheet looks good, but I'm not sure if it's all versions proove.
For my code I have put a check in the references at 'Microsoft Excel 16.0 Object Library'
And this all works.
If I uncheck the reference, VBA returns errors.
No problem so far... just keep it on!?
Problem:
But what if an other user doesn't have it checked? Or has an older version of the Object Library?
It would give an error for him, wouldn't it?
I read things about early and late binding, where the early binding could give problems with this.
So I tried to change it to a late binding (using Objects).
When unchecking the Excel Object Library box, the code will still return errors.
Did I do something wrong? (Probably!)
Extra info:
sQuery = Name from the Query
sPath = Filepath where the sheet needs to be added
Both come from other sub
This is my code:
VBA Code:
Private Sub cmdTransfer(ByVal sQuery As String, sPath As String)
On Error GoTo SubError
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim rsl As DAO.Recordset
Dim iCols As Integer
Dim i As Integer
Dim bExcelOpened As Boolean
'Change cursor to hourglass
DoCmd.Hourglass (True)
'**********************************************************
' GET DATA
'**********************************************************
'Put sQuery in recordset
Set rsl = CurrentDb.OpenRecordset(sQuery, dbOpenSnapshot)
'If empty > Exit Excel
If rsl.RecordCount = 0 Then
MsgBox "no data"
GoTo SubExit
End If
'**********************************************************
' SPREADSHEET BUILD UP
'**********************************************************
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo SubError
Set xlApp = CreateObject("Excel.Application")
bExcelOpened = False
Else 'Excel was already running
bExcelOpened = True
End If
xlApp.Visible = False
xlApp.screenupdating = False
'Open Workbook on sPath
Set xlBook = xlApp.Workbooks.Open(sPath)
'Set sheet as first sheet
Set xlSheet = xlBook.sheets.Add(Before:=xlBook.sheets(1))
With xlSheet
'General formatting sheet
.Name = "List"
.Tab.ColorIndex = 6
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 11
'Add titles from table
For iCols = 0 To rsl.Fields.Count - 1
.Cells(3, iCols + 1).Value = rsl.Fields(iCols).Name
Next
'Format titles from tabel
With xlSheet.Range(xlSheet.Cells(3, 1), _
xlSheet.Cells(3, rsl.Fields.Count))
.Font.Bold = True
.Font.ColorIndex = 2
.HorizontalAlignment = xlCenter
End With
'Add BIG title in A1
With .Range("A1")
.Value = "This sheet contains the list"
End With
'Format BIG title
With xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, rsl.Fields.Count))
.Merge
.Cells.Font.Size = 15
.Font.Bold = True
.Font.ColorIndex = 1 'See: https://analysistabs.com/excel-vba/colorindex/
.Interior.ColorIndex = 36
.HorizontalAlignment = xlCenter
End With
'Get Data from sQuery
.Range("A4").CopyFromRecordset rsl
'Format first column
With xlSheet.Columns("A:A")
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
'Define range from Data sQuery
Dim indexLastColumn As Integer
indexLastColumn = .Cells(4, .Columns.Count).End(xlToLeft).Column
Dim indexLastRow As Integer
indexLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Dim RangeTabel As Range
Set RangeTabel = xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(indexLastRow, indexLastColumn))
'Name Table
Dim TableName As String
TableName = "Tbl_List"
'Format data sQuery as Table and name it
xlSheet.ListObjects.Add(xlSrcRange, RangeTabel, , xlYes).Name = TableName
'Format Table
With xlSheet.ListObjects(TableName)
.TableStyle = "TableStyleMedium2"
.Range.AutoFilter
End With
'ReDefine LastRow
indexLastRow = indexLastRow + 4
'Add text in new last line + merg, colour and borders
With xlSheet.Range(xlSheet.Cells(indexLastRow, 1), _
xlSheet.Cells(indexLastRow, indexLastColumn))
.Merge
.Value = "For more information, contact me"
.Interior.ColorIndex = 36
.Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
.Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
.Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
End With
'Autofit rows and columns
.Columns("B").ColumnWidth = 120 'first wide to prevent early text wrap
.Rows.AutoFit
.Columns.AutoFit
'Select first cel
.Range("A1").Select
'Select first sheet in workbook
xlBook.sheets(1).Select
End With
xlApp.DisplayAlerts = False
xlBook.Close True, sPath 'Save and close the workbook
xlApp.DisplayAlerts = True
'Close excel if is wasn't originally running
If bExcelOpened = False Then
xlApp.Quit
End If
SubExit:
On Error Resume Next
DoCmd.Hourglass False
xlApp.Visible = True
rsl.Close
Set rsl = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
xlApp.screenupdating = True
Set xlApp = Nothing
Exit Sub
SubError:
Error_Handler:
MsgBox "An error occured:" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: cmdTransfer" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "Error!"
Resume SubExit
End Sub
Many thanks for helping me clearing this out!
Greetz
R