Export to Excel: 2nd, 3rd, etc excel files not opening up

  • Thread starter Thread starter Ken Nguyen
  • Start date Start date
K

Ken Nguyen

Ok, after a few weeks of trying to figure this out i've finally decided to
ask the pros.

I created a tracking database that allowed for exporting to excel (this is
done and works fine). I also was able to format that same exported excel
sheet that was created and it opens up after it has been formatted (this
works perfectly). The problem I am having is after I export the first excel
file any other exports after doesn't open up. It gets created and semi
formatted only. The first export is formatted in it's entirety to my
specifications, but all others get formatted (not in it's entirety or opens
up). What could be the problem?

Here are parts of my codes (You may use this code for your application as
long as you credit me):

Function: command button to export

'determines the path of where the database is
length = Len(CurrentProject.path)
For X = 1 To length
'finds \ and goes up one level
If Mid(CurrentProject.path, X, 1) = "\" Then
myValue = X
End If
Next X
'stores path to mypath
myPath = Left(CurrentProject.path, myValue)

'request user for a filename
myValue = InputBox("Please give your spreadsheet a filename (Make it
detailed): " & Chr(13) & "For example: 8-12-2007 Report of AB602", "Saving
Spreadsheet File")

'exports to excel using transferspreadsheet
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Qry_SpreadsheetONEc", myValue, True
'title of spreadsheet for header
Forms!frmMenu!txtXLStitle = "Sort by Analyst for " & cmbOptions

'Calls function to format the excel workbook
Call ModifyExportedExcelFileFormats(myValue)

Public Sub ModifyExportedExcelFileFormats(sFile As String)
On Error GoTo Err_ModifyExportedExcelFileFormats

'Declare variables
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
'excel application stuff
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Open(sFile)
For Each xlSheet In xlBook.Worksheets

'Sets the header
rStart = "A1"
rEnd = "Y1"
'Sets the data
cStart = "A2"
cEnd = "Y" & txtNumRecords + 1 'added the plus 1 to include the header
'Sets for repeat columns
rcStart = rStart
rcEnd = "B" & txtNumRecords + 1 'added the plus 1 to include the
header

'freeze panes
xlSheet.Activate
xlSheet.Range("C2", "C2").Select
xlApp.ActiveWindow.FreezePanes = True

'set column widths
xlSheet.Range("A1").ColumnWidth = 9.57
xlSheet.Range("B1").ColumnWidth = 5.5
xlSheet.Range("C1").ColumnWidth = 12.43
xlSheet.Range("D1").ColumnWidth = 9.71
xlSheet.Range("E1").ColumnWidth = 14.57
xlSheet.Range("F1").ColumnWidth = 20
xlSheet.Range("G1").ColumnWidth = 13.5
xlSheet.Range("H1").ColumnWidth = 12.57
xlSheet.Range("I1").ColumnWidth = 16
xlSheet.Range("J1").ColumnWidth = 60
xlSheet.Range("K1").ColumnWidth = 60
xlSheet.Range("L1").ColumnWidth = 10
xlSheet.Range("M1").ColumnWidth = 13
xlSheet.Range("N1").ColumnWidth = 10
xlSheet.Range("O1").ColumnWidth = 10
xlSheet.Range("P1").ColumnWidth = 10
xlSheet.Range("Q1").ColumnWidth = 10
xlSheet.Range("R1").ColumnWidth = 10
xlSheet.Range("S1").ColumnWidth = 10
xlSheet.Range("T1").ColumnWidth = 15
xlSheet.Range("U1").ColumnWidth = 12
xlSheet.Range("V1").ColumnWidth = 15
xlSheet.Range("W1").ColumnWidth = 12
xlSheet.Range("X1").ColumnWidth = 6
xlSheet.Range("Y1").ColumnWidth = 60

'format header row
xlSheet.Range(rStart, rEnd).Font.Bold = True
xlSheet.Range(rStart, rEnd).Interior.ColorIndex = 15
xlSheet.Range(rStart, rEnd).WrapText = True
xlSheet.Range(rStart, rEnd).HorizontalAlignment = xlCenter

'format repeated columns
xlSheet.Range(rcStart, rcEnd).Font.Bold = True

'header row borders
xlSheet.Range(rStart, rEnd).Borders(xlLeft).Weight = xlThin
xlSheet.Range(rStart, rEnd).Borders(xlRight).Weight = xlThin
xlSheet.Range(rStart, rEnd).Borders(xlTop).Weight = xlThin
xlSheet.Range(rStart, rEnd).Borders(xlBottom).Weight = xlThin

'set header row height
xlSheet.Range(rStart).RowHeight = 45

'make columns wrap
xlSheet.Range(rStart, rEnd).WrapText = True
xlSheet.Range(cStart, cEnd).WrapText = True

'Autoformat the cells
xlSheet.Range(rStart, cEnd).Select
Selection.AutoFormat Format:=xlRangeAutoFormatList1, Number:=False,
Font _
:=False, Alignment:=False, Border:=False, Pattern:=True,
Width:=False

'Creates borders around each cell
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

'Deselects all records and selects the first cell
xlSheet.Range(rStart).Select

'**********************************************
'** SETS UP THE PRINT SETUP
'**********************************************
'Sets page to landscape
xlSheet.PageSetup.Orientation = xlLandscape
'Repeat title rows
xlSheet.PageSetup.PrintTitleRows = "$1:$1"
'Repeat title columns
xlSheet.PageSetup.PrintTitleColumns = "$A:$B"
'Sets the Headers
xlSheet.PageSetup.LeftHeader = ""
xlSheet.PageSetup.CenterHeader = "IAS Tracking System - Redline
Tracking Log" & Chr(10) & "Fiscal Year " & cmbFiscalYear & Chr(10) &
Forms!frmMenu!txtXLStitle
xlSheet.PageSetup.RightHeader = ""
xlSheet.PageSetup.LeftFooter = "California Department of Education"
xlSheet.PageSetup.CenterFooter = "Page &P of &N"
xlSheet.PageSetup.RightFooter = "&D - &T"
'Sets Margins
xlSheet.PageSetup.LeftMargin = 1
xlSheet.PageSetup.RightMargin = 1
xlSheet.PageSetup.TopMargin = 35
xlSheet.PageSetup.BottomMargin = 15
xlSheet.PageSetup.HeaderMargin = 10
xlSheet.PageSetup.FooterMargin = 5
'Sets Print Headings of the Columns i.e. A, B, C
xlSheet.PageSetup.PrintHeadings = False
'Sets Print Gridlines
xlSheet.PageSetup.PrintGridlines = True
xlSheet.PageSetup.PrintComments = xlPrintNoComments
'Printing of the records
xlSheet.PageSetup.CenterHorizontally = False
xlSheet.PageSetup.CenterVertically = False
'Sets page orientation
xlSheet.PageSetup.Orientation = xlLandscape
'Sets the paper size
xlSheet.PageSetup.PaperSize = xlPaperLetter
'Sets page number
xlSheet.PageSetup.FirstPageNumber = xlAutomatic
'Sets the order of the printing
xlSheet.PageSetup.Order = xlOverThenDown
'Sets to black and white printing
xlSheet.PageSetup.BlackAndWhite = False
xlSheet.PageSetup.Zoom = False
'Sets the page to print 1 page by x
xlSheet.PageSetup.FitToPagesWide = 2
xlSheet.PageSetup.FitToPagesTall = 9999
'Prints the errors or not
xlSheet.PageSetup.PrintErrors = xlPrintErrorsDisplayed
Next

'save file
xlBook.Save

'done
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

Exit_ModifyExportedExcelFileFormats:
Call OpenExcelFile(sFile)

Exit Sub

Err_ModifyExportedExcelFileFormats:
vStatusBar = SysCmd(acSysCmdClearStatus)
'MsgBox Err.Number & " - " & Err.Description
Resume Exit_ModifyExportedExcelFileFormats
End Sub

Sub OpenExcelFile(strPathToFile As String)
Dim xlApp As Object

On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")
Set xlApp = GetObject(strPathToFile)

xlApp.Application.Visible = True
xlApp.Parent.Windows(1).Visible = True

End Sub
 
You code is trying to create an instance of Excel.exe, but after the first
occurance, it is already running. what you need to do is first try to use
the existing instance. If it doesn't exist, then create an instance:

On Error Resume Next ' Defer error trapping.
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlApp = CreateObject("excel.application")
End If
Err.Clear ' Clear Err object in case error occurred.

Also, you are using Early Binding. That is, defining the object as an Excel
Application in your Dim statment. Although this may give you a slight
performance edge opening the first instance, it has issues. For example, if
you compile you app on one version, but the target user changes versions of
Excel, your app will fail. Using late binding, it loads whatever version the
user has. Here are my Dims:

Private xlApp As Object 'Application Object
Private xlBook As Object 'Workbook Object
Private xlSheet As Object 'Worksheet Object
 
Thank you Dave for your response. However, I would like to stick with the
early bindings to use the built-in functions of excel to format my excel
sheets. I wasn't able to find anything about formatting excel using late
bindings and learn that it would be too difficult to re-write and re-code.

Well based on your suggestions my understanding is that in my early binding
declarations I am trying to create a new instance of Excel.exe each time the
code is ran so I am assuming to fix this is to check to see if the instance
is already there if so reuse it else create a new one?

I think i got my understanding down however I don't know if my code meets my
understanding please advise while still retaining the early bindings.

Public Sub ModifyExportedExcelFileFormats(sFile As String)
On Error GoTo Err_ModifyExportedExcelFileFormats

'Declare early binding variables
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

'excel application stuff
On Error Resume Next 'defer error trapping.
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlApp = New Excel.Application
End If
Err.Clear ' Clear Err object in case error occurred.
'Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Open(sFile)

'Declare late binding variables
'Private xlApp As Object
'Private xlBook As Object
'Private xlSheet As Object

'Set xlApp = CreateObject("Excel.Application")
'Set xlBook = x1App.Workbooks.Open(sFile)
For Each xlSheet In xlBook.Worksheets

Thanks in advance for your help.
 
Ken,
There is no difference in the coding for early or late binding. It is just
different ways of establishing an excel object and manipulating it. Here is
what will happen using early binding (it happened to me going from 2000 to
2003).

I had an app that had early binding written for 2000. That is, for Office
2000, not Access 2000. Our desktop people begin rolling out 2003 to users.
As each user was moved to 2003, the application broke. The libraries for
2000 were different from 2003. All I had to do was change to late binding
and the problem went away. Trust me on this, I spent two years at a place
where the users wanted no reports, they wanted all reporting, including
charts, in Excel. I have done this a bunch and I would not use early binding.
 
Ken,

The way I get around this is to use early binding as I develop my code.
Gives me access to Intellisense, and since my knowledge of the Excel object
model is extremely limited, I need all the Intellisense I can get.

Then, just prior to deployment, I change the Dim statements to Objects and
like Dave put a remark indicating what that object will actually be, making
it easy for me to go back to early binding if I have to.

HTH
Dale
 
Thanks you Dale, and Dave for your response.

Dave, I understand your reasoning so it looks like I will pursue in changing
it to late binding.

Dale, I followed your advice and use early binding to have everything work
and then changed it to late binding but now it just doesn't format my excel
sheets nomore. Do you see anything wrong with this?

I used TransferSpreadsheet function to export a query to excel say its
filename and path is c:/temp/test.xls

the function ModifyExportedExcelFileFormats is then called and the filepath
is passed to the function as a string (sFile)

For now I am just trying to format the file that was exported using
TransferSpreadsheet not bother trying to open it up after formatting.

What is causing it to not format the excel file?


Public Sub ModifyExportedExcelFileFormats(sFile As String)
On Error GoTo Err_ModifyExportedExcelFileFormats

'Declare variables
'Dim xlApp As Excel.Application
'Dim xlBook As Excel.Workbook
'Dim xlSheet As Excel.Worksheet
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object

'excel application stuff
'Set xlApp = New Excel.Application
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlApp = CreateObject("Excel.application")
End If
Err.Clear

Set xlBook = xlApp.Workbooks.Open(sFile)
For Each xlSheet In xlBook.Worksheets

'Sets the header
rStart = "A1"
rEnd = "Y1"
'Sets the data
cStart = "A2"
cEnd = "Y" & txtNumRecords + 1 'added the plus 1 to include the header
'Sets for repeat columns
rcStart = rStart
rcEnd = "B" & txtNumRecords + 1 'added the plus 1 to include the
header

'freeze panes
xlSheet.Activate
xlSheet.Range("C2", "C2").Select
xlApp.ActiveWindow.FreezePanes = True

'set column widths
xlSheet.Range("A1").ColumnWidth = 9.57
xlSheet.Range("B1").ColumnWidth = 5.5
xlSheet.Range("C1").ColumnWidth = 12.43
xlSheet.Range("D1").ColumnWidth = 9.71
xlSheet.Range("E1").ColumnWidth = 14.57
xlSheet.Range("F1").ColumnWidth = 20
xlSheet.Range("G1").ColumnWidth = 13.5
xlSheet.Range("H1").ColumnWidth = 12.57
xlSheet.Range("I1").ColumnWidth = 16
xlSheet.Range("J1").ColumnWidth = 60
xlSheet.Range("K1").ColumnWidth = 60
xlSheet.Range("L1").ColumnWidth = 10
xlSheet.Range("M1").ColumnWidth = 13
xlSheet.Range("N1").ColumnWidth = 10
xlSheet.Range("O1").ColumnWidth = 10
xlSheet.Range("P1").ColumnWidth = 10
xlSheet.Range("Q1").ColumnWidth = 10
xlSheet.Range("R1").ColumnWidth = 10
xlSheet.Range("S1").ColumnWidth = 10
xlSheet.Range("T1").ColumnWidth = 15
xlSheet.Range("U1").ColumnWidth = 12
xlSheet.Range("V1").ColumnWidth = 15
xlSheet.Range("W1").ColumnWidth = 12
xlSheet.Range("X1").ColumnWidth = 6
xlSheet.Range("Y1").ColumnWidth = 60

'format header row
xlSheet.Range(rStart, rEnd).Font.Bold = True
xlSheet.Range(rStart, rEnd).Interior.ColorIndex = 15
xlSheet.Range(rStart, rEnd).WrapText = True
xlSheet.Range(rStart, rEnd).HorizontalAlignment = xlCenter

'format repeated columns
xlSheet.Range(rcStart, rcEnd).Font.Bold = True

'header row borders
xlSheet.Range(rStart, rEnd).Borders(xlLeft).Weight = xlThin
xlSheet.Range(rStart, rEnd).Borders(xlRight).Weight = xlThin
xlSheet.Range(rStart, rEnd).Borders(xlTop).Weight = xlThin
xlSheet.Range(rStart, rEnd).Borders(xlBottom).Weight = xlThin

'set header row height
xlSheet.Range(rStart).RowHeight = 45

'make columns wrap
xlSheet.Range(rStart, rEnd).WrapText = True
xlSheet.Range(cStart, cEnd).WrapText = True

'Autoformat the cells
xlSheet.Range(rStart, cEnd).Select
Selection.AutoFormat Format:=xlRangeAutoFormatList1, Number:=False,
Font _
:=False, Alignment:=False, Border:=False, Pattern:=True,
Width:=False

'Creates borders around each cell
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

'Deselects all records and selects the first cell
xlSheet.Range(rStart).Select

'**********************************************
'** SETS UP THE PRINT SETUP
'**********************************************
'Sets page to landscape
xlSheet.PageSetup.Orientation = xlLandscape
'Repeat title rows
xlSheet.PageSetup.PrintTitleRows = "$1:$1"
'Repeat title columns
xlSheet.PageSetup.PrintTitleColumns = "$A:$B"
'Sets the Headers
xlSheet.PageSetup.LeftHeader = ""
xlSheet.PageSetup.CenterHeader = "IAS Tracking System - Redline
Tracking Log" & Chr(10) & "Fiscal Year " & cmbFiscalYear & Chr(10) &
Forms!frmMenu!txtXLStitle
xlSheet.PageSetup.RightHeader = ""
xlSheet.PageSetup.LeftFooter = ""
xlSheet.PageSetup.CenterFooter = "Page &P of &N"
xlSheet.PageSetup.RightFooter = "&D - &T"
'Sets Margins
xlSheet.PageSetup.LeftMargin = 1
xlSheet.PageSetup.RightMargin = 1
xlSheet.PageSetup.TopMargin = 35
xlSheet.PageSetup.BottomMargin = 15
xlSheet.PageSetup.HeaderMargin = 10
xlSheet.PageSetup.FooterMargin = 5
'Sets Print Headings of the Columns i.e. A, B, C
xlSheet.PageSetup.PrintHeadings = False
'Sets Print Gridlines
xlSheet.PageSetup.PrintGridlines = True
xlSheet.PageSetup.PrintComments = xlPrintNoComments
'Printing of the records
xlSheet.PageSetup.CenterHorizontally = False
xlSheet.PageSetup.CenterVertically = False
'Sets page orientation
xlSheet.PageSetup.Orientation = xlLandscape
'Sets the paper size
xlSheet.PageSetup.PaperSize = xlPaperLetter
'Sets page number
xlSheet.PageSetup.FirstPageNumber = xlAutomatic
'Sets the order of the printing
xlSheet.PageSetup.Order = xlOverThenDown
'Sets to black and white printing
xlSheet.PageSetup.BlackAndWhite = False
xlSheet.PageSetup.Zoom = False
'Sets the page to print 1 page by x
xlSheet.PageSetup.FitToPagesWide = 2
xlSheet.PageSetup.FitToPagesTall = 9999
'Prints the errors or not
xlSheet.PageSetup.PrintErrors = xlPrintErrorsDisplayed
Next

'save file
xlBook.Save

'done
xlBook.Close
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

Exit_ModifyExportedExcelFileFormats:
'Call OpenExcelFile(sFile)

Exit Sub

Err_ModifyExportedExcelFileFormats:
vStatusBar = SysCmd(acSysCmdClearStatus)
'MsgBox Err.Number & " - " & Err.Description
Resume Exit_ModifyExportedExcelFileFormats
End Sub
 
Ken,

I would do the following:

1. Reiterate your On Error Goto line after opening the application. If you
don't turn this back on you will continue to run through the whole
application and not generate any errors. Since the only in-line error
checking you have is after the GetObject line, you must get your error
checking working again.

On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlApp = CreateObject("Excel.application")
Err.Clear
End If

On Error GoTo Err_ModifyExportedExcelFileFormats


2. Make the spreadsheet visible, so that you can step through your code and
see what is happening (at least during the debug process).

xlApp.Visible = True

3. In the FreezePanes code try:

xlSheet.Range("C2").Select

4. In your Column width code use the following format. Although you way
will work, specifying the column ("A:A") as the range is easier to read and
understand.

xlSheet.Range("A:A").columnwidth = 9.57

Cannot recall when/if I have ever used most of the other formatting stuff
that you have indicated in your code. I think, if you make Excel visible,
and turn your error handling back on, you will quickly figure out what is
happening. I'd probably step through the code as well, so I could see
exactly what was happening on the spreadsheet, for each line of code.

HTH
Dale
 
Hey Dale,

After stepping through the code I found the problem had to do with some of
my excel formatting code (these were grabbed from the excel macro created).

I don't know why it causes an issue so I took it out. However, I wish I
could use them.

Anyhow regarding this piece of code

On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlApp = CreateObject("Excel.application")
Err.Clear
End If

On Error GoTo Err_ModifyExportedExcelFileFormats

It seemed like it wouldnt work for me. so I remark them out and just used
this piece of code. Since at the end of the function it clears the instance
created for xlApp it should be fine.

Set xlApp = CreateObject("Excel.application")

This is my code.

Public Sub ModifyExportedExcelFileFormats(sFile As String)
On Error GoTo Err_ModifyExportedExcelFileFormats

'Declare variables
'Dim xlApp As Excel.Application
Dim xlApp As Object
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
'excel application stuff
'Set xlApp = New Excel.Application
'On Error Resume Next
'Set xlApp = GetObject(, "Excel.Application")

'If Err.Number <> 0 Then
Set xlApp = CreateObject("Excel.Application")
' Err.Clear
'End If
'On Error GoTo Err_ModifyExportedExcelFileFormats

Set xlBook = xlApp.Workbooks.Open(sFile)
For Each xlSheet In xlBook.Worksheets

'Sets the header
rStart = "A1"
rEnd = "Y1"
'Sets the data
cStart = "A2"
cEnd = "Y" & txtNumRecords + 1 'added the plus 1 to include the header
'Sets for repeat columns
rcStart = rStart
rcEnd = "B" & txtNumRecords + 1 'added the plus 1 to include the
header

'freeze panes
xlSheet.Activate
xlSheet.Range("C2").Select
xlApp.ActiveWindow.FreezePanes = True

'set column widths
xlSheet.Range("A:A").ColumnWidth = 9.57
xlSheet.Range("B:B").ColumnWidth = 5.5
xlSheet.Range("C:C").ColumnWidth = 12.43
xlSheet.Range("D:D").ColumnWidth = 9.71
xlSheet.Range("E:E").ColumnWidth = 14.57
xlSheet.Range("F:F").ColumnWidth = 20
xlSheet.Range("G:G").ColumnWidth = 13.5
xlSheet.Range("H:H").ColumnWidth = 12.57
xlSheet.Range("I:I").ColumnWidth = 16
xlSheet.Range("J:J").ColumnWidth = 60
xlSheet.Range("K:K").ColumnWidth = 60
xlSheet.Range("L:L").ColumnWidth = 10
xlSheet.Range("M:M").ColumnWidth = 13
xlSheet.Range("N:N").ColumnWidth = 10
xlSheet.Range("O:O").ColumnWidth = 10
xlSheet.Range("P:P").ColumnWidth = 10
xlSheet.Range("Q:Q").ColumnWidth = 10
xlSheet.Range("R:R").ColumnWidth = 10
xlSheet.Range("S:S").ColumnWidth = 10
xlSheet.Range("T:T").ColumnWidth = 15
xlSheet.Range("U:U").ColumnWidth = 12
xlSheet.Range("V:V").ColumnWidth = 15
xlSheet.Range("W:W").ColumnWidth = 12
xlSheet.Range("X:X").ColumnWidth = 6.5
xlSheet.Range("Y:Y").ColumnWidth = 60

'format header row
xlSheet.Range(rStart, rEnd).Font.Bold = True
xlSheet.Range(rStart, rEnd).Interior.ColorIndex = 15
xlSheet.Range(rStart, rEnd).WrapText = True
xlSheet.Range(rStart, rEnd).HorizontalAlignment = xlCenter

'format repeated columns
xlSheet.Range(rcStart, rcEnd).Font.Bold = True

'header row borders
xlSheet.Range(rStart, rEnd).Borders(xlLeft).Weight = xlThin
xlSheet.Range(rStart, rEnd).Borders(xlRight).Weight = xlThin
xlSheet.Range(rStart, rEnd).Borders(xlTop).Weight = xlThin
xlSheet.Range(rStart, rEnd).Borders(xlBottom).Weight = xlThin

'set header row height
xlSheet.Range(rStart).RowHeight = 45

'make columns wrap
xlSheet.Range(rStart, rEnd).WrapText = True
xlSheet.Range(cStart, cEnd).WrapText = True

'**************************************************
' DOES NOT WORK / CAUSES PROBLEMS
'**************************************************
'Autoformat the cells
'xlSheet.Range(rStart, cEnd).Select
'Selection.AutoFormat Format:=xlRangeAutoFormatList1, Number:=False,
Font _
' :=False, Alignment:=False, Border:=False, Pattern:=True,
Width:=False

'Creates borders around each cell
'With Selection.Borders(xlEdgeLeft)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlEdgeTop)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlEdgeBottom)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlEdgeRight)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlInsideVertical)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'With Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
'End With
'*************************************************

'Deselects all records and selects the first cell
xlSheet.Range(rStart).Select

'**********************************************
'** SETS UP THE PRINT SETUP
'**********************************************
'Sets page to landscape
xlSheet.PageSetup.Orientation = xlLandscape
'Repeat title rows
xlSheet.PageSetup.PrintTitleRows = "$1:$1"
'Repeat title columns
xlSheet.PageSetup.PrintTitleColumns = "$A:$B"
'Sets the Headers
xlSheet.PageSetup.LeftHeader = ""
xlSheet.PageSetup.CenterHeader = "IAS Tracking System - Redline
Tracking Log" & Chr(10) & "Fiscal Year " & cmbFiscalYear & Chr(10) &
Forms!frmMenu!txtXLStitle
xlSheet.PageSetup.RightHeader = ""
xlSheet.PageSetup.LeftFooter = "California Department of Education"
xlSheet.PageSetup.CenterFooter = "Page &P of &N"
xlSheet.PageSetup.RightFooter = "&D - &T"
'Sets Margins
xlSheet.PageSetup.LeftMargin = 1
xlSheet.PageSetup.RightMargin = 1
xlSheet.PageSetup.TopMargin = 35
xlSheet.PageSetup.BottomMargin = 15
xlSheet.PageSetup.HeaderMargin = 10
xlSheet.PageSetup.FooterMargin = 5
'Sets Print Headings of the Columns i.e. A, B, C
xlSheet.PageSetup.PrintHeadings = False
'Sets Print Gridlines
xlSheet.PageSetup.PrintGridlines = True
xlSheet.PageSetup.PrintComments = xlPrintNoComments
'Printing of the records
xlSheet.PageSetup.CenterHorizontally = False
xlSheet.PageSetup.CenterVertically = False
'Sets page orientation
xlSheet.PageSetup.Orientation = xlLandscape
'Sets the paper size
xlSheet.PageSetup.PaperSize = xlPaperLetter
'Sets page number
xlSheet.PageSetup.FirstPageNumber = xlAutomatic
'Sets the order of the printing
xlSheet.PageSetup.Order = xlOverThenDown
'Sets to black and white printing
xlSheet.PageSetup.BlackAndWhite = False
xlSheet.PageSetup.Zoom = False
'Sets the page to print 1 page by x
xlSheet.PageSetup.FitToPagesWide = 2
xlSheet.PageSetup.FitToPagesTall = 9999
'Prints the errors or not
xlSheet.PageSetup.PrintErrors = xlPrintErrorsDisplayed
Next

'save file
xlBook.Save

'done
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

Exit_ModifyExportedExcelFileFormats:
Call OpenExcelFile(sFile)

Exit Sub

Err_ModifyExportedExcelFileFormats:
vStatusBar = SysCmd(acSysCmdClearStatus)
'MsgBox Err.Number & " - " & Err.Description
Resume Exit_ModifyExportedExcelFileFormats
End Sub

Sub OpenExcelFile(strPathToFile As String)
Dim xlApp As Object

On Error Resume Next

Set xlApp = GetObject(, "Excel.Application")
Set xlApp = GetObject(strPathToFile)

xlApp.Application.Visible = True
xlApp.Parent.Windows(1).Visible = True

Set xlApp = Nothing
End Sub
 
Back
Top