formating spreadsheet

  • Thread starter Thread starter Jake F
  • Start date Start date
J

Jake F

I've been running this code for awhile without problems and am now getting a
"subscript out of range error" number 9. I can run the code fine if I skip
the spreadsheet formatting so the error is somewhere in there. I can't see
the problem so maybe someone here can. Thanks.

Public Function JobCodeAndOption()
On Error GoTo Err_JobCodeAndOption

'Set variables of workbook
Dim strFilePath As String
Dim strFileName As String
Dim strOutputFile As String
Dim strMessage As String

strFilePath = "X:\Agency_Files\Human
Resources\User\Classification\Options"
strFileName = "Job Codes and Options " & Format(Date, "yyyy-mm-dd") &
".xls"
strOutputFile = strFilePath & "\" & strFileName

'************************ Create Excel File *************************

'Puts qryJobCodes&Options into Job Codes worksheet
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel8, _
"qryJobCodes&Options", _
strOutputFile, _
True, _
"Jobs_Options"

'Puts qryJobOptions&Codes into Job Options worksheet
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel8, _
"qryJobOptions&Codes", _
strOutputFile, _
True, _
"Options_Jobs"


'************************ Format Job Codes Worksheet *************************

'Set variables to format the download
Dim objXLApp As Object
Dim objXLBook As Object
Dim objXLSheet1 As Object
Dim objXLSheet2 As Object

'Set the objects to format
Set objXLApp = CreateObject("Excel.Application")
Set objXLBook = objXLApp.Workbooks.Open(strFilePath & "\" & strFileName)
Set objXLSheet1 = objXLBook.Worksheets("Job_Codes")
Set objXLSheet2 = objXLBook.Worksheets("Job_Options")

'Autofit columns
objXLSheet1.Range("A:E").Columns.AutoFit
objXLSheet2.Range("A:E").Columns.AutoFit

'Bold
objXLSheet1.Range("A1:E1").Font.Bold = True
objXLSheet2.Range("A1:E1").Font.Bold = True

'Autocenter
objXLSheet1.Range("A1:E1").HorizontalAlignment = xlLeft
objXLSheet2.Range("A1:E1").HorizontalAlignment = xlLeft

'Change font color
objXLSheet1.Range("A1:E1").Font.ColorIndex = 2
objXLSheet2.Range("A1:E1").Font.ColorIndex = 2

'Change background cell color
objXLSheet1.Range("A1:E1").Interior.ColorIndex = 37
objXLSheet2.Range("A1:E1").Interior.ColorIndex = 44

'************************ Clean-Up *************************
objXLBook.Save
objXLBook.Close
objXLApp.Quit

Set objXLSheet1 = Nothing
Set objXLSheet2 = Nothing
Set objXLBook = Nothing
Set objXLApp = Nothing

'Enter date into last run field on form
Forms![frmReportRun]![Last Run] = Date

Exit_JobCodeAndOption:
Exit Function

Err_JobCodeAndOption:
MsgBox Err.Description
MsgBox Err.Number
Resume Exit_JobCodeAndOption:

End Function
 
As your tittle states, you have a spread sheet problem, this news group is
for Access Databases, you may get a better answer to your problem if you
posted in Excel News Groups.

Having said that, have you tried putting a stop statement at the first line
of the format section and then sigle steeping the code through using F8
button to narrow down the faulty line????

I hope this helps a little????

Regards
--
Advice to Posters.
Check your post for replies or request for more information.
Consider providing some feed back to the response you have recieved.
Kindest Regards Mike B


Jake F said:
I've been running this code for awhile without problems and am now getting a
"subscript out of range error" number 9. I can run the code fine if I skip
the spreadsheet formatting so the error is somewhere in there. I can't see
the problem so maybe someone here can. Thanks.

Public Function JobCodeAndOption()
On Error GoTo Err_JobCodeAndOption

'Set variables of workbook
Dim strFilePath As String
Dim strFileName As String
Dim strOutputFile As String
Dim strMessage As String

strFilePath = "X:\Agency_Files\Human
Resources\User\Classification\Options"
strFileName = "Job Codes and Options " & Format(Date, "yyyy-mm-dd") &
".xls"
strOutputFile = strFilePath & "\" & strFileName

'************************ Create Excel File *************************

'Puts qryJobCodes&Options into Job Codes worksheet
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel8, _
"qryJobCodes&Options", _
strOutputFile, _
True, _
"Jobs_Options"

'Puts qryJobOptions&Codes into Job Options worksheet
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel8, _
"qryJobOptions&Codes", _
strOutputFile, _
True, _
"Options_Jobs"


'************************ Format Job Codes Worksheet *************************

'Set variables to format the download
Dim objXLApp As Object
Dim objXLBook As Object
Dim objXLSheet1 As Object
Dim objXLSheet2 As Object

'Set the objects to format
Set objXLApp = CreateObject("Excel.Application")
Set objXLBook = objXLApp.Workbooks.Open(strFilePath & "\" & strFileName)
Set objXLSheet1 = objXLBook.Worksheets("Job_Codes")
Set objXLSheet2 = objXLBook.Worksheets("Job_Options")

'Autofit columns
objXLSheet1.Range("A:E").Columns.AutoFit
objXLSheet2.Range("A:E").Columns.AutoFit

'Bold
objXLSheet1.Range("A1:E1").Font.Bold = True
objXLSheet2.Range("A1:E1").Font.Bold = True

'Autocenter
objXLSheet1.Range("A1:E1").HorizontalAlignment = xlLeft
objXLSheet2.Range("A1:E1").HorizontalAlignment = xlLeft

'Change font color
objXLSheet1.Range("A1:E1").Font.ColorIndex = 2
objXLSheet2.Range("A1:E1").Font.ColorIndex = 2

'Change background cell color
objXLSheet1.Range("A1:E1").Interior.ColorIndex = 37
objXLSheet2.Range("A1:E1").Interior.ColorIndex = 44

'************************ Clean-Up *************************
objXLBook.Save
objXLBook.Close
objXLApp.Quit

Set objXLSheet1 = Nothing
Set objXLSheet2 = Nothing
Set objXLBook = Nothing
Set objXLApp = Nothing

'Enter date into last run field on form
Forms![frmReportRun]![Last Run] = Date

Exit_JobCodeAndOption:
Exit Function

Err_JobCodeAndOption:
MsgBox Err.Description
MsgBox Err.Number
Resume Exit_JobCodeAndOption:

End Function
Click to expand...
 
I'll give the single stepping a shot. I know it's formatting the
spreadsheet, but I'm controlling it through access.

MikeJohnB said:
As your tittle states, you have a spread sheet problem, this news group is
for Access Databases, you may get a better answer to your problem if you
posted in Excel News Groups.

Having said that, have you tried putting a stop statement at the first line
of the format section and then sigle steeping the code through using F8
button to narrow down the faulty line????

I hope this helps a little????

Regards
--
Advice to Posters.
Check your post for replies or request for more information.
Consider providing some feed back to the response you have recieved.
Kindest Regards Mike B


Jake F said:
I've been running this code for awhile without problems and am now getting a
"subscript out of range error" number 9. I can run the code fine if I skip
the spreadsheet formatting so the error is somewhere in there. I can't see
the problem so maybe someone here can. Thanks.

Public Function JobCodeAndOption()
On Error GoTo Err_JobCodeAndOption

'Set variables of workbook
Dim strFilePath As String
Dim strFileName As String
Dim strOutputFile As String
Dim strMessage As String

strFilePath = "X:\Agency_Files\Human
Resources\User\Classification\Options"
strFileName = "Job Codes and Options " & Format(Date, "yyyy-mm-dd") &
".xls"
strOutputFile = strFilePath & "\" & strFileName

'************************ Create Excel File *************************

'Puts qryJobCodes&Options into Job Codes worksheet
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel8, _
"qryJobCodes&Options", _
strOutputFile, _
True, _
"Jobs_Options"

'Puts qryJobOptions&Codes into Job Options worksheet
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel8, _
"qryJobOptions&Codes", _
strOutputFile, _
True, _
"Options_Jobs"


'************************ Format Job Codes Worksheet *************************

'Set variables to format the download
Dim objXLApp As Object
Dim objXLBook As Object
Dim objXLSheet1 As Object
Dim objXLSheet2 As Object

'Set the objects to format
Set objXLApp = CreateObject("Excel.Application")
Set objXLBook = objXLApp.Workbooks.Open(strFilePath & "\" & strFileName)
Set objXLSheet1 = objXLBook.Worksheets("Job_Codes")
Set objXLSheet2 = objXLBook.Worksheets("Job_Options")

'Autofit columns
objXLSheet1.Range("A:E").Columns.AutoFit
objXLSheet2.Range("A:E").Columns.AutoFit

'Bold
objXLSheet1.Range("A1:E1").Font.Bold = True
objXLSheet2.Range("A1:E1").Font.Bold = True

'Autocenter
objXLSheet1.Range("A1:E1").HorizontalAlignment = xlLeft
objXLSheet2.Range("A1:E1").HorizontalAlignment = xlLeft

'Change font color
objXLSheet1.Range("A1:E1").Font.ColorIndex = 2
objXLSheet2.Range("A1:E1").Font.ColorIndex = 2

'Change background cell color
objXLSheet1.Range("A1:E1").Interior.ColorIndex = 37
objXLSheet2.Range("A1:E1").Interior.ColorIndex = 44

'************************ Clean-Up *************************
objXLBook.Save
objXLBook.Close
objXLApp.Quit

Set objXLSheet1 = Nothing
Set objXLSheet2 = Nothing
Set objXLBook = Nothing
Set objXLApp = Nothing

'Enter date into last run field on form
Forms![frmReportRun]![Last Run] = Date

Exit_JobCodeAndOption:
Exit Function

Err_JobCodeAndOption:
MsgBox Err.Description
MsgBox Err.Number
Resume Exit_JobCodeAndOption:

End Function
Click to expand...
Click to expand...
 
I think the problem lies with TransferSpreadsheet commands. There is no sheet
named Job Codes created.
 
Back
Top