View Full Version : Setting a range object & applying table style
bigal.nz
06-02-2016, 12:35 PM
Hi All,
I am creating a spreadsheet from MS Access via VBA - and this works well. I am running into problems however setting a table style to a range in the Excel file.
It doesn't seem to apply the style, and occasionally throws a error which I don;t have handy right now but will add it if I can reproduce.
My code is:
Private Sub btn_Excel_NG_Click()
Dim rst As DAO.Recordset
Dim strSQL As String
Dim qdfnew As DAO.QueryDef
Dim RecordCount As String
Dim xl As Excel.Application
Dim wb As Object
' ***********************
' ** CREATE QUERY
' ***********************
strSQL = "SELECT TABLE.Event, DateStart, Suburb, FirstName, Name, Home, DOB, FROM SAM INNER JOIN tbl_records ON Table.Event = tbl_records.Event WHERE (tbl_records.NGEmailed Is Null);"
' ***********************
' ** EXPORT TO EXCEL FILE
' ***********************
Set qdfnew = CurrentDb.CreateQueryDef("excelQuery", strSQL)
FileName = "S:\Hub\Processed\Email\" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
DoCmd.TransferSpreadsheet acExport, 10, "excelQuery", FileName, True
DoCmd.Close acQuery, "excelQuery"
CurrentDb.QueryDefs.Delete qdfnew.Name
' ********************
' ** FORMAT EXCEL FILE
' ********************
Set xl = New Excel.Application
Set wb = xl.Workbooks.Open(FileName)
With wb.Sheets(qdfnew.Name)
.rows("1:1").Font.Bold = True
.Columns("A:Z").AutoFit
End With
Dim tbl As ListObject
Dim rng As Range
Worksheets(qdfnew.Name).Activate
Set rng = Range("A50:N50") ' <- HOW CAN I MAKE THIS THE ALL DATA RATHER THAN HARD CODE
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStylemedium2"
Set tbl = Nothing
wb.Save
wb.Close
Set wb = Nothing
xl.Quit
Set xl = Nothing
End Sub
Thanks in advance,
-Al
mdmackillop
06-02-2016, 01:53 PM
Set Rng = Range("A50:N50") ' <- HOW CAN I MAKE THIS THE ALL DATA RATHER THAN HARD CODE
Is the data "isolated", If so try
Set Rng = Range("A50:N50").CurrentRegion
bigal.nz
06-02-2016, 02:24 PM
Ok,
The error that is coming up is:
Run-time error '1004':
Method 'Worksheets' of object '_Global' failed
and it is on the line:
Worksheets(qdfnew.Name).Activate
It only comes up every other time I run the program.
I think it is something to do with the way the workbook is declared:
Dim wb As Object - perhaps should be Dim wb As Excel.Worksheet - and I think when I refer to the range object it needs to be a fully qualified reference, but I am trying to work out what this reference should look like.
I hope this helps?
Cheers
-Al
mdmackillop
06-02-2016, 03:02 PM
You're losing the scope of the wb object.
Try
wb.Sheets(qdfnew.Name).activate
This adds a worksheet object to pull things together (hopefully)
Private Sub btn_Excel_NG_Click()
Dim rst As DAO.Recordset
Dim strSQL As String
Dim qdfnew As DAO.QueryDef
Dim RecordCount As String
Dim xl As Excel.Application
Dim wb As Object
Dim ws As Object
Dim tbl As ListObject
Dim rng As Range
' ***********************
' ** CREATE QUERY
' ***********************
strSQL = "SELECT TABLE.Event, DateStart, Suburb, FirstName, Name, Home, DOB, FROM SAM INNER JOIN tbl_records ON Table.Event = tbl_records.Event WHERE (tbl_records.NGEmailed Is Null);"
' ***********************
' ** EXPORT TO EXCEL FILE
' ***********************
Set qdfnew = CurrentDb.CreateQueryDef("excelQuery", strSQL)
Filename = "S:\Email for NGOs\" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
DoCmd.TransferSpreadsheet acExport, 10, "excelQuery", Filename, True
DoCmd.Close acQuery, "excelQuery"
CurrentDb.QueryDefs.Delete qdfnew.Name
' ********************
' ** FORMAT EXCEL FILE
' ********************
Set xl = New Excel.Application
Set wb = xl.Workbooks.Open(Filename)
Set ws = wb.Sheets(qdfnew.Name)
With ws
.Rows("1:1").Font.Bold = True
.Columns("A:Z").AutoFit
Set rng = .Range("A50:N50") ' <- HOW CAN I MAKE THIS THE ALL DATA RATHER THAN HARD CODE
Set tbl = .ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStylemedium2"
End With
Set tbl = Nothing
wb.Save
wb.Close
Set wb = Nothing
xl.Quit
Set xl = Nothing
End Sub
bigal.nz
06-02-2016, 03:57 PM
Thanks for the reply - testing it now. Can you please check your PM re post?
Also there are now no errors, and the bold and the autofit get applied (although they were before too) but the Table Style is not applied.
Code now looks like this:
Private Sub btn_Excel_NG_Click()
Dim rst As DAO.Recordset
Dim strSQL As String
Dim qdfnew As DAO.QueryDef
Dim RecordCount As String
Dim xl As Excel.Application
Dim wb As Object
Dim ws As Object
Dim rng As Range
Dim tbl As ListObject
' ***********************
' ** CREATE QUERY
' ***********************
strSQL = "SELECT Event, DateStart, Suburb, FirstName, WHERE etc etc etc ;"
' ***********************
' ** EXPORT TO EXCEL FILE
' ***********************
Set qdfnew = CurrentDb.CreateQueryDef("excelQuery", strSQL)
FileName = "S:\Hub\Processed\Email\" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
DoCmd.TransferSpreadsheet acExport, 10, "excelQuery", FileName, True
DoCmd.Close acQuery, "excelQuery"
CurrentDb.QueryDefs.Delete qdfnew.Name
' ********************
' ** FORMAT EXCEL FILE
' ********************
Set xl = New Excel.Application
Set wb = xl.Workbooks.Open(FileName)
Set ws = wb.Sheets(qdfnew.Name)
With ws
.Rows("1:1").Font.Bold = True
.Columns("A:Z").AutoFit
Set rng = .Range("A50:N50")
Set tbl = .ListObjects.Add(xlSrcRange, rng, , xlYes)
tbl.TableStyle = "TableStylemedium2"
End With
Set tbl = Nothing
wb.Save
wb.Close
Set wb = Nothing
xl.Quit
Set xl = Nothing
End Sub
bigal.nz
06-02-2016, 04:07 PM
My bad - I needed to change A50:N50 to A1:N50 - although I will try to get this working with xlLastCell
mdmackillop
06-02-2016, 04:13 PM
Try range("A1") .CurrentRegion (if appropriate)
bigal.nz
06-02-2016, 04:25 PM
I got it to work with your method and Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
Now i just need to insert a new cell at the end of the range before formatting.
I have counted the colums in the range, guess I need to +1 then insert? Then redefine range?
-A
or ?
Private Sub M_snb()
c00 = "S:\Hub\Processed\Email\" & Format(Now, "ddmmyyyy_hhmm") & ".xlsx"
CurrentDb.CreateQueryDef "excelQuery", "SELECT TABLE.Event, DateStart, Suburb, FirstName, Name, Home, DOB, FROM SAM INNER JOIN tbl_records ON Table.Event = tbl_records.Event WHERE (tbl_records.NGEmailed Is Null);"
DoCmd.TransferSpreadsheet acExport, 10, "excelQuery", c00, True
DoCmd.Close acQuery, "excelQuery"
CurrentDb.QueryDefs.Delete "excelQuery"
With GetObject(c00)
.Sheets(1).ListObjects.Add(1, .Sheets(1).Cells(1).CurrentRegion, , xlYes).TableStyle = "TableStylemedium2"
.Close -1
End With
End Sub
PS I don't see the need to create a new tabelquery and delete it afterwards ? I think it can be permanent and applied every time you need it in this macro.
Paul_Hossler
06-03-2016, 06:12 AM
I got it to work with your method and Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
Now i just need to insert a new cell at the end of the range before formatting.
I have counted the colums in the range, guess I need to +1 then insert? Then redefine range?
IF you just use
set rng = ws.Range("A1") .CurrentRegion
and your table is one 'block' of data containing A1 (ex. A1:N50) rng will be set to the entire block A1:N50
If your table is one 'block' of data containing A1 (ex. A1:Z123) rng will be set to the entire block A1:Z123
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.