Excel Automation

P

PK

Please Help! I have been running cirlcles with this one for 2 days!

My code below opens an existing spreadsheet (from an access 2002 form
button), does some formatting on two different tabs, then closes and saves
the spreadsheet.

Here is the problem: When it completes, there is still an EXCEL.EXE process
in Task Manager. Also If I try to open the spreadsheet, i get only the EXCEL
header (no spreadsheet). I then close that, and kill the EXCEL.EXE process,
and I can open the spreadsheet with no problems (and everything is formatted
properly)

TIA for any help you can provide!!!!

Code:



If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If

objXL.Application.Visible = False
objXL.Application.Workbooks.Open "MySpreadsheet.xls"
Set objActiveWkb = objXL.Application.ActiveWorkbook

With objActiveWkb
.Application.ActiveWindow.Zoom = 75
.Application.ActiveWindow.WindowState = xlMaximized
.Application.Sheets("Summary").Select
.Application.Range("A1").Select
.Application.Range(Selection, Selection.End(xlToRight)).Select
With .Application.Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
.Application.Selection.Font.Bold = True
.Application.ActiveWindow.SplitRow = 0.764705882352941
.Application.ActiveWindow.FreezePanes = True
.Application.Columns("A:F").EntireColumn.AutoFit
.Application.Columns("B:F").Select
.Application.Selection.NumberFormat = "0%"
'second
tab-------------------------------------------------------------
.Application.Sheets("Supporting_Data").Select
.Application.ActiveWindow.Zoom = 75
.Application.Range("A1").Select
.Application.Range(Selection, Selection.End(xlToRight)).Select
With .Application.Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
.Application.Selection.Font.Bold = True
.Application.ActiveWindow.SplitRow = 0.764705882352941
.Application.ActiveWindow.FreezePanes = True
.Application.Columns("A:AB").EntireColumn.AutoFit
.Application.Columns("J:K").Select
.Application.Selection.ColumnWidth = 46
.Application.Range("A1").Select
.Application.Sheets("Summary").Select
.Application.Range("A1").Select
End With

objActiveWkb.Close savechanges:=True

If boolXL Then
objXL.Application.Quit
End If


Set objActiveWkb = Nothing
Set objXL = Nothing
 
K

Klatuu

Assuming you are using the Quit method for the Excel Application object, this
is caused by incorrect establishment of objects. If you establish a
reference to an Excel object that it can't associate with the original object
you established, it will create another instance of Excel and you will not
know it is happening. Then when you execute the Quit, it destroys only the
reference you established. Be sure you always establish any reference to an
Excel object that is qualified back to your orignal object. For example:
Dim xlApp as Object
Dim xlBook as Object
Dim xlSheet as Object

Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Add
Set xlsheet = xlBook.ActiveSheet

Note that each new object references an already established object.
 
P

PK

Klatuu, Thank you very much for your response.
Unfortunately, I am not sure how I would adjust my code to follow your
example - could you be more specific? (using my code as reference)
 
P

PK

Klatuu In addition to my previous response, I appologize for not giving you
the "DIM"s from the begining of the sub in my original posting of the code.
This is what was in the sub (before the code i posted):

Dim boolXL As Boolean
Dim objXL As Object
Dim objActiveWkb As Object
 
K

Klatuu

I see more problems than I have time to correct. Rather, I will give you a
couple of examples from my code that you can use as a model:
On Error Resume Next ' Defer error trapping.
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelWasNotRunning = True
Set xlApp = CreateObject("excel.application")
Else
DetectExcel
End If
Err.Clear ' Clear Err object in case error occurred.
On Error GoTo LoadAdjustedActuals_Err
DoEvents
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True)
xlBook.Worksheets("Actuals_res_export").Activate
ActiveSheet.Range("F3").Select
Selection.End(xlDown).Select
intLastRow = Selection.Row
If intLastRow = 0 Then
MsgBox "No Data to Import" & vbNewLine & "Spreadsheet may be open by
another user", _
vbExclamation + vbOKOnly, "Import Adjusted Actuals"
GoTo LoadAdjustedActuals_Exit
End If

'Start the Loop
For intRowCount = 3 To intLastRow
rstAccess.AddNew
For intColCount = 6 To 42
rstAccess.Fields(intColCount - 6) = _
IIf(intColCount < 26, ActiveSheet.Cells(intRowCount,
intColCount), _
Nz(ActiveSheet.Cells(intRowCount, intColCount), 0))
Next intColCount
rstAccess.Update
Next intRowCount
Me.txtAccessDollars = DSum("[CURRENT MO $'s]", "AdjustedActuals")
Me.txtAccessRows = rstAccess.RecordCount
strCurrDollarsRange = "AP3:AP" & CStr(intLastRow)
Me.txtXlDollars =
xlApp.WorksheetFunction.Sum(ActiveSheet.Range(strCurrDollarsRange))
Me.txtXlRows = intLastRow - 2
MsgBox "Import Complete", vbExclamation + vbOKOnly, "Import Adjusted
Actuals"

LoadAdjustedActuals_Exit:
'Close files and delete link to spreadsheet
On Error Resume Next
xlBook.Close
Set xlBook = Nothing
'If we createed a new instance of Excel
If blnExcelWasNotRunning = True Then
xlApp.Application.Quit
End If
Set xlApp = Nothing
rstAccess.Close
Set rstAccess = Nothing
DoCmd.Hourglass False
Exit Sub

Here is some formatting code:

'D A Hargis 5/2005
'Formats the data sheet

'Variables for positioning formatting
Dim strLeftRange As String
Dim strRightRange As String

'Put Borders around the Data Areas
'Forecast area
strLeftRange = "A28"
strRightRange = IIf(blnRecurring, "M32", "M36")
With xlsheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Actuals area
strLeftRange = IIf(blnRecurring, "A34", "A38")
strRightRange = IIf(blnRecurring, "M38", "M42")
With xlsheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Variance area
strLeftRange = IIf(blnRecurring, "A40", "A44")
strRightRange = IIf(blnRecurring, "M44", "M48")
With xlsheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Set up data formatting
With xlsheet
'Forecast data and if NR, Pipeline data
strLeftRange = "B29"
strRightRange = IIf(blnRecurring, "M30", "M32")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Actual data
strLeftRange = IIf(blnRecurring, "B35", "B39")
strRightRange = IIf(blnRecurring, "M36", "M40")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Variance Data
strLeftRange = IIf(blnRecurring, "B41", "B45")
strRightRange = IIf(blnRecurring, "M42", "M46")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Forecast SP
strLeftRange = IIf(blnRecurring, "B31", "B33")
strRightRange = IIf(blnRecurring, "M32", "M36")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
'Actual SP
strLeftRange = IIf(blnRecurring, "B37", "B41")
strRightRange = IIf(blnRecurring, "M38", "M42")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
'Variance SP
strLeftRange = IIf(blnRecurring, "B43", "B47")
strRightRange = IIf(blnRecurring, "M44", "M48")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
End With

'Misc formatting
With xlsheet
.Columns("A").ColumnWidth = 14
.Columns("B:M").ColumnWidth = 9.49
strLeftRange = "A26"
strRightRange = IIf(blnRecurring, "M44", "M48")
For Each cell In xlsheet.Range(strLeftRange, strRightRange)
cell.Font.Size = 10
cell.Font.Name = "MS Sans Serif"
Next
For Each cell In xlsheet.Range("B27", "M27")
cell.Font.Bold = True
Next
.Cells(28, 1).Font.Bold = True
.Cells(IIf(blnRecurring, 34, 38), 1).Font.Bold = True
.Cells(IIf(blnRecurring, 40, 44), 1).Font.Bold = True
.Cells(27, 2).Value = "J'" & Right(Me.txtCurrYear, 2)
.Cells(27, 3).Value = "F"
.Cells(27, 4).Value = "M"
.Cells(27, 5).Value = "A"
.Cells(27, 6).Value = "M"
.Cells(27, 7).Value = "J"
.Cells(27, 8).Value = "J"
.Cells(27, 9).Value = "A"
.Cells(27, 10).Value = "S"
.Cells(27, 11).Value = "O"
.Cells(27, 12).Value = "N"
.Cells(27, 13).Value = "D"
.Cells(28, 1).Value = "Forecast"
.Cells(29, 1).Value = "Month"
.Cells(30, 1).Value = "Plan Cum"
.Cells(31, 1).Value = IIf(blnRecurring, "SP mo", "Pipeline Plan")
.Cells(32, 1).Value = IIf(blnRecurring, "SP cum", "Pipeline Cum")
If Not blnRecurring Then
.Cells(33, 1).Value = "SP mo"
.Cells(34, 1).Value = "SP Mo Pipeline"
.Cells(35, 1).Value = "SP cum"
.Cells(36, 1).Value = "SP cum Pipeline"
End If
.Cells(IIf(blnRecurring, 34, 38), 1).Value = "Actual"
.Cells(IIf(blnRecurring, 35, 39), 1).Value = "Month"
.Cells(IIf(blnRecurring, 36, 40), 1).Value = "Act cum"
.Cells(IIf(blnRecurring, 37, 41), 1).Value = "SP mo"
.Cells(IIf(blnRecurring, 38, 42), 1).Value = "SP cum"
.Cells(IIf(blnRecurring, 40, 44), 1).Value = "Variance"
.Cells(IIf(blnRecurring, 41, 45), 1).Value = "Month"
.Cells(IIf(blnRecurring, 42, 46), 1).Value = "cum"
.Cells(IIf(blnRecurring, 43, 47), 1).Value = "SP mo"
.Cells(IIf(blnRecurring, 44, 48), 1).Value = "SP cum"
End With

'Page Setup For Printing
With xlsheet.PageSetup
.Orientation = xlPortrait
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
.LeftFooter = "&F" & " " & "&A"
.RightFooter = "&D" & " " & "&T"
.LeftMargin = xlApp.InchesToPoints(1)
.RightMargin = xlApp.InchesToPoints(0)
.TopMargin = xlApp.InchesToPoints(0.25)
.BottomMargin = xlApp.InchesToPoints(0.5)
.HeaderMargin = xlApp.InchesToPoints(0.25)
.FooterMargin = xlApp.InchesToPoints(0.25)
End With

xlApp.Windows(xlBook.Name).Zoom = 75
 
K

Klatuu

One thing I forgot to mention. A good technigue for determining where the
additional instances of Excel are being established is to open the Task
Manager and select the Processes tab. Then go into debug mode and step
through your code one line at a time. You will see when a new instance of
Excel is established.
 
P

PK

Klatuu, thank you again for your responses. Please hang in there with me :)

As i looked at your code, I see basically nothing different between what you
are doing and what I am doing. Keep in mind, the formatting of the
spreadsheet works PERFECTLY. The only issue that I have is that the EXCEL
instance does not seem to go away.

At your suggestion, I started Task Manager, and stepped through the program.
1) I saw the excel instance start when the SET OBJXL=CREATEOBJECT("Excel
Application")
2) All of the formatting worked perfectly
3) When the objXL.Application.Quit code ran, the excel instance did not go
away.
4) The sub finished. I killed the Excel.exe task from task manager, and
went into the spreadsheet. The spreadsheet was perfectly formatted.

What am I missing?






Klatuu said:
I see more problems than I have time to correct. Rather, I will give you a
couple of examples from my code that you can use as a model:
On Error Resume Next ' Defer error trapping.
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelWasNotRunning = True
Set xlApp = CreateObject("excel.application")
Else
DetectExcel
End If
Err.Clear ' Clear Err object in case error occurred.
On Error GoTo LoadAdjustedActuals_Err
DoEvents
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True)
xlBook.Worksheets("Actuals_res_export").Activate
ActiveSheet.Range("F3").Select
Selection.End(xlDown).Select
intLastRow = Selection.Row
If intLastRow = 0 Then
MsgBox "No Data to Import" & vbNewLine & "Spreadsheet may be open by
another user", _
vbExclamation + vbOKOnly, "Import Adjusted Actuals"
GoTo LoadAdjustedActuals_Exit
End If

'Start the Loop
For intRowCount = 3 To intLastRow
rstAccess.AddNew
For intColCount = 6 To 42
rstAccess.Fields(intColCount - 6) = _
IIf(intColCount < 26, ActiveSheet.Cells(intRowCount,
intColCount), _
Nz(ActiveSheet.Cells(intRowCount, intColCount), 0))
Next intColCount
rstAccess.Update
Next intRowCount
Me.txtAccessDollars = DSum("[CURRENT MO $'s]", "AdjustedActuals")
Me.txtAccessRows = rstAccess.RecordCount
strCurrDollarsRange = "AP3:AP" & CStr(intLastRow)
Me.txtXlDollars =
xlApp.WorksheetFunction.Sum(ActiveSheet.Range(strCurrDollarsRange))
Me.txtXlRows = intLastRow - 2
MsgBox "Import Complete", vbExclamation + vbOKOnly, "Import Adjusted
Actuals"

LoadAdjustedActuals_Exit:
'Close files and delete link to spreadsheet
On Error Resume Next
xlBook.Close
Set xlBook = Nothing
'If we createed a new instance of Excel
If blnExcelWasNotRunning = True Then
xlApp.Application.Quit
End If
Set xlApp = Nothing
rstAccess.Close
Set rstAccess = Nothing
DoCmd.Hourglass False
Exit Sub

Here is some formatting code:

'D A Hargis 5/2005
'Formats the data sheet

'Variables for positioning formatting
Dim strLeftRange As String
Dim strRightRange As String

'Put Borders around the Data Areas
'Forecast area
strLeftRange = "A28"
strRightRange = IIf(blnRecurring, "M32", "M36")
With xlsheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Actuals area
strLeftRange = IIf(blnRecurring, "A34", "A38")
strRightRange = IIf(blnRecurring, "M38", "M42")
With xlsheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Variance area
strLeftRange = IIf(blnRecurring, "A40", "A44")
strRightRange = IIf(blnRecurring, "M44", "M48")
With xlsheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Set up data formatting
With xlsheet
'Forecast data and if NR, Pipeline data
strLeftRange = "B29"
strRightRange = IIf(blnRecurring, "M30", "M32")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Actual data
strLeftRange = IIf(blnRecurring, "B35", "B39")
strRightRange = IIf(blnRecurring, "M36", "M40")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Variance Data
strLeftRange = IIf(blnRecurring, "B41", "B45")
strRightRange = IIf(blnRecurring, "M42", "M46")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Forecast SP
strLeftRange = IIf(blnRecurring, "B31", "B33")
strRightRange = IIf(blnRecurring, "M32", "M36")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
'Actual SP
strLeftRange = IIf(blnRecurring, "B37", "B41")
strRightRange = IIf(blnRecurring, "M38", "M42")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
'Variance SP
strLeftRange = IIf(blnRecurring, "B43", "B47")
strRightRange = IIf(blnRecurring, "M44", "M48")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
End With

'Misc formatting
With xlsheet
.Columns("A").ColumnWidth = 14
.Columns("B:M").ColumnWidth = 9.49
strLeftRange = "A26"
strRightRange = IIf(blnRecurring, "M44", "M48")
For Each cell In xlsheet.Range(strLeftRange, strRightRange)
cell.Font.Size = 10
cell.Font.Name = "MS Sans Serif"
Next
For Each cell In xlsheet.Range("B27", "M27")
cell.Font.Bold = True
Next
.Cells(28, 1).Font.Bold = True
.Cells(IIf(blnRecurring, 34, 38), 1).Font.Bold = True
.Cells(IIf(blnRecurring, 40, 44), 1).Font.Bold = True
.Cells(27, 2).Value = "J'" & Right(Me.txtCurrYear, 2)
.Cells(27, 3).Value = "F"
.Cells(27, 4).Value = "M"
.Cells(27, 5).Value = "A"
.Cells(27, 6).Value = "M"
.Cells(27, 7).Value = "J"
.Cells(27, 8).Value = "J"
.Cells(27, 9).Value = "A"
.Cells(27, 10).Value = "S"
.Cells(27, 11).Value = "O"
.Cells(27, 12).Value = "N"
.Cells(27, 13).Value = "D"
.Cells(28, 1).Value = "Forecast"
.Cells(29, 1).Value = "Month"
.Cells(30, 1).Value = "Plan Cum"
.Cells(31, 1).Value = IIf(blnRecurring, "SP mo", "Pipeline Plan")
.Cells(32, 1).Value = IIf(blnRecurring, "SP cum", "Pipeline Cum")
If Not blnRecurring Then
.Cells(33, 1).Value = "SP mo"
.Cells(34, 1).Value = "SP Mo Pipeline"
.Cells(35, 1).Value = "SP cum"
.Cells(36, 1).Value = "SP cum Pipeline"
End If
.Cells(IIf(blnRecurring, 34, 38), 1).Value = "Actual"
.Cells(IIf(blnRecurring, 35, 39), 1).Value = "Month"
.Cells(IIf(blnRecurring, 36, 40), 1).Value = "Act cum"
.Cells(IIf(blnRecurring, 37, 41), 1).Value = "SP mo"
.Cells(IIf(blnRecurring, 38, 42), 1).Value = "SP cum"
.Cells(IIf(blnRecurring, 40, 44), 1).Value = "Variance"
.Cells(IIf(blnRecurring, 41, 45), 1).Value = "Month"
.Cells(IIf(blnRecurring, 42, 46), 1).Value = "cum"
.Cells(IIf(blnRecurring, 43, 47), 1).Value = "SP mo"
.Cells(IIf(blnRecurring, 44, 48), 1).Value = "SP cum"
End With

'Page Setup For Printing
With xlsheet.PageSetup
.Orientation = xlPortrait
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
.LeftFooter = "&F" & " " & "&A"
.RightFooter = "&D" & " " & "&T"
.LeftMargin = xlApp.InchesToPoints(1)
.RightMargin = xlApp.InchesToPoints(0)
.TopMargin = xlApp.InchesToPoints(0.25)
.BottomMargin = xlApp.InchesToPoints(0.5)
.HeaderMargin = xlApp.InchesToPoints(0.25)
.FooterMargin = xlApp.InchesToPoints(0.25)
End With

xlApp.Windows(xlBook.Name).Zoom = 75

Klatuu said:
Assuming you are using the Quit method for the Excel Application object, this
is caused by incorrect establishment of objects. If you establish a
reference to an Excel object that it can't associate with the original object
you established, it will create another instance of Excel and you will not
know it is happening. Then when you execute the Quit, it destroys only the
reference you established. Be sure you always establish any reference to an
Excel object that is qualified back to your orignal object. For example:
Dim xlApp as Object
Dim xlBook as Object
Dim xlSheet as Object

Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Add
Set xlsheet = xlBook.ActiveSheet

Note that each new object references an already established object.
Click to expand...
Click to expand...
 
K

Klatuu

Yes, sometime you don't see it create another one. I am not saying your code
does not do the job, but if you look at the differences in our code, you will
see that in some cases, you are overqualifying. For example, most of the
places you are using .Application are not necessary.
I know this is frustrating and hard to ferett out. I went through this
about 3 months ago having the same problem. I was given the same advise, and
just kept trying different techniques until I got it working.

Good Luck.

PK said:
Klatuu, thank you again for your responses. Please hang in there with me :)

As i looked at your code, I see basically nothing different between what you
are doing and what I am doing. Keep in mind, the formatting of the
spreadsheet works PERFECTLY. The only issue that I have is that the EXCEL
instance does not seem to go away.

At your suggestion, I started Task Manager, and stepped through the program.
1) I saw the excel instance start when the SET OBJXL=CREATEOBJECT("Excel
Application")
2) All of the formatting worked perfectly
3) When the objXL.Application.Quit code ran, the excel instance did not go
away.
4) The sub finished. I killed the Excel.exe task from task manager, and
went into the spreadsheet. The spreadsheet was perfectly formatted.

What am I missing?






Klatuu said:
I see more problems than I have time to correct. Rather, I will give you a
couple of examples from my code that you can use as a model:
On Error Resume Next ' Defer error trapping.
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
blnExcelWasNotRunning = True
Set xlApp = CreateObject("excel.application")
Else
DetectExcel
End If
Err.Clear ' Clear Err object in case error occurred.
On Error GoTo LoadAdjustedActuals_Err
DoEvents
xlApp.DisplayAlerts = False
xlApp.Interactive = False
xlApp.ScreenUpdating = False
Set xlBook = xlApp.Workbooks.Open(varGetFileName, 0, True)
xlBook.Worksheets("Actuals_res_export").Activate
ActiveSheet.Range("F3").Select
Selection.End(xlDown).Select
intLastRow = Selection.Row
If intLastRow = 0 Then
MsgBox "No Data to Import" & vbNewLine & "Spreadsheet may be open by
another user", _
vbExclamation + vbOKOnly, "Import Adjusted Actuals"
GoTo LoadAdjustedActuals_Exit
End If

'Start the Loop
For intRowCount = 3 To intLastRow
rstAccess.AddNew
For intColCount = 6 To 42
rstAccess.Fields(intColCount - 6) = _
IIf(intColCount < 26, ActiveSheet.Cells(intRowCount,
intColCount), _
Nz(ActiveSheet.Cells(intRowCount, intColCount), 0))
Next intColCount
rstAccess.Update
Next intRowCount
Me.txtAccessDollars = DSum("[CURRENT MO $'s]", "AdjustedActuals")
Me.txtAccessRows = rstAccess.RecordCount
strCurrDollarsRange = "AP3:AP" & CStr(intLastRow)
Me.txtXlDollars =
xlApp.WorksheetFunction.Sum(ActiveSheet.Range(strCurrDollarsRange))
Me.txtXlRows = intLastRow - 2
MsgBox "Import Complete", vbExclamation + vbOKOnly, "Import Adjusted
Actuals"

LoadAdjustedActuals_Exit:
'Close files and delete link to spreadsheet
On Error Resume Next
xlBook.Close
Set xlBook = Nothing
'If we createed a new instance of Excel
If blnExcelWasNotRunning = True Then
xlApp.Application.Quit
End If
Set xlApp = Nothing
rstAccess.Close
Set rstAccess = Nothing
DoCmd.Hourglass False
Exit Sub

Here is some formatting code:

'D A Hargis 5/2005
'Formats the data sheet

'Variables for positioning formatting
Dim strLeftRange As String
Dim strRightRange As String

'Put Borders around the Data Areas
'Forecast area
strLeftRange = "A28"
strRightRange = IIf(blnRecurring, "M32", "M36")
With xlsheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Actuals area
strLeftRange = IIf(blnRecurring, "A34", "A38")
strRightRange = IIf(blnRecurring, "M38", "M42")
With xlsheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Variance area
strLeftRange = IIf(blnRecurring, "A40", "A44")
strRightRange = IIf(blnRecurring, "M44", "M48")
With xlsheet.Range(strLeftRange, strRightRange)
.Borders(xlTop).LineStyle = xlContinuous
.Borders(xlTop).Weight = xlThin
.Borders(xlBottom).LineStyle = xlContinuous
.Borders(xlBottom).Weight = xlThin
.Borders(xlLeft).LineStyle = xlContinuous
.Borders(xlLeft).Weight = xlThin
.Borders(xlRight).LineStyle = xlContinuous
.Borders(xlRight).Weight = xlThin
End With

'Set up data formatting
With xlsheet
'Forecast data and if NR, Pipeline data
strLeftRange = "B29"
strRightRange = IIf(blnRecurring, "M30", "M32")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Actual data
strLeftRange = IIf(blnRecurring, "B35", "B39")
strRightRange = IIf(blnRecurring, "M36", "M40")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Variance Data
strLeftRange = IIf(blnRecurring, "B41", "B45")
strRightRange = IIf(blnRecurring, "M42", "M46")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0;(#,##0); - "
'Forecast SP
strLeftRange = IIf(blnRecurring, "B31", "B33")
strRightRange = IIf(blnRecurring, "M32", "M36")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
'Actual SP
strLeftRange = IIf(blnRecurring, "B37", "B41")
strRightRange = IIf(blnRecurring, "M38", "M42")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
'Variance SP
strLeftRange = IIf(blnRecurring, "B43", "B47")
strRightRange = IIf(blnRecurring, "M44", "M48")
.Range(strLeftRange, strRightRange).NumberFormat = _
"#,##0.0;(#,##0.0); - "
End With

'Misc formatting
With xlsheet
.Columns("A").ColumnWidth = 14
.Columns("B:M").ColumnWidth = 9.49
strLeftRange = "A26"
strRightRange = IIf(blnRecurring, "M44", "M48")
For Each cell In xlsheet.Range(strLeftRange, strRightRange)
cell.Font.Size = 10
cell.Font.Name = "MS Sans Serif"
Next
For Each cell In xlsheet.Range("B27", "M27")
cell.Font.Bold = True
Next
.Cells(28, 1).Font.Bold = True
.Cells(IIf(blnRecurring, 34, 38), 1).Font.Bold = True
.Cells(IIf(blnRecurring, 40, 44), 1).Font.Bold = True
.Cells(27, 2).Value = "J'" & Right(Me.txtCurrYear, 2)
.Cells(27, 3).Value = "F"
.Cells(27, 4).Value = "M"
.Cells(27, 5).Value = "A"
.Cells(27, 6).Value = "M"
.Cells(27, 7).Value = "J"
.Cells(27, 8).Value = "J"
.Cells(27, 9).Value = "A"
.Cells(27, 10).Value = "S"
.Cells(27, 11).Value = "O"
.Cells(27, 12).Value = "N"
.Cells(27, 13).Value = "D"
.Cells(28, 1).Value = "Forecast"
.Cells(29, 1).Value = "Month"
.Cells(30, 1).Value = "Plan Cum"
.Cells(31, 1).Value = IIf(blnRecurring, "SP mo", "Pipeline Plan")
.Cells(32, 1).Value = IIf(blnRecurring, "SP cum", "Pipeline Cum")
If Not blnRecurring Then
.Cells(33, 1).Value = "SP mo"
.Cells(34, 1).Value = "SP Mo Pipeline"
.Cells(35, 1).Value = "SP cum"
.Cells(36, 1).Value = "SP cum Pipeline"
End If
.Cells(IIf(blnRecurring, 34, 38), 1).Value = "Actual"
.Cells(IIf(blnRecurring, 35, 39), 1).Value = "Month"
.Cells(IIf(blnRecurring, 36, 40), 1).Value = "Act cum"
.Cells(IIf(blnRecurring, 37, 41), 1).Value = "SP mo"
.Cells(IIf(blnRecurring, 38, 42), 1).Value = "SP cum"
.Cells(IIf(blnRecurring, 40, 44), 1).Value = "Variance"
.Cells(IIf(blnRecurring, 41, 45), 1).Value = "Month"
.Cells(IIf(blnRecurring, 42, 46), 1).Value = "cum"
.Cells(IIf(blnRecurring, 43, 47), 1).Value = "SP mo"
.Cells(IIf(blnRecurring, 44, 48), 1).Value = "SP cum"
End With

'Page Setup For Printing
With xlsheet.PageSetup
.Orientation = xlPortrait
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
.LeftFooter = "&F" & " " & "&A"
.RightFooter = "&D" & " " & "&T"
.LeftMargin = xlApp.InchesToPoints(1)
.RightMargin = xlApp.InchesToPoints(0)
.TopMargin = xlApp.InchesToPoints(0.25)
.BottomMargin = xlApp.InchesToPoints(0.5)
.HeaderMargin = xlApp.InchesToPoints(0.25)
.FooterMargin = xlApp.InchesToPoints(0.25)
End With

xlApp.Windows(xlBook.Name).Zoom = 75

Klatuu said:
Assuming you are using the Quit method for the Excel Application object, this
is caused by incorrect establishment of objects. If you establish a
reference to an Excel object that it can't associate with the original object
you established, it will create another instance of Excel and you will not
know it is happening. Then when you execute the Quit, it destroys only the
reference you established. Be sure you always establish any reference to an
Excel object that is qualified back to your orignal object. For example:
Dim xlApp as Object
Dim xlBook as Object
Dim xlSheet as Object

Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Add
Set xlsheet = xlBook.ActiveSheet

Note that each new object references an already established object.


:

Please Help! I have been running cirlcles with this one for 2 days!

My code below opens an existing spreadsheet (from an access 2002 form
button), does some formatting on two different tabs, then closes and saves
the spreadsheet.

Here is the problem: When it completes, there is still an EXCEL.EXE process
in Task Manager. Also If I try to open the spreadsheet, i get only the EXCEL
header (no spreadsheet). I then close that, and kill the EXCEL.EXE process,
and I can open the spreadsheet with no problems (and everything is formatted
properly)

TIA for any help you can provide!!!!

Code:



If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If

objXL.Application.Visible = False
objXL.Application.Workbooks.Open "MySpreadsheet.xls"
Set objActiveWkb = objXL.Application.ActiveWorkbook

With objActiveWkb
.Application.ActiveWindow.Zoom = 75
.Application.ActiveWindow.WindowState = xlMaximized
.Application.Sheets("Summary").Select
.Application.Range("A1").Select
Click to expand...
Click to expand...
Click to expand...
 
P

PK

Klatuu, in my book you are a SAINT for hanging in there with me!

You are absolutely correct that it is in the format section.

I think if you can correct just one of the lines of code, i will finally get
it.

I broke EVERYTHING into much simpler question for you.

This simple code will open a spreadsheet, select the first row of data,
shade it, bold it, split the window, and freeze it. I put 2 remarks " the
problem is between here---" and "here----" in the code

I know it is in there because if i simply select A1 and shade it in that
section everything runs perfect and no extra excel process is left running.
THANKS AGAIN!







Dim objXL As Object
Dim objWKB As Object

Set objXL = CreateObject("Excel.Application")
objXL.Application.Visible = True
objXL.Application.Workbooks.Open "Myfile.xls"
Set objWKB = objXL.Application.ActiveWorkbook

' PROBLEM IS BETWEEN
HERE------------------------------------------------------
With objWKB
.Application.Sheets("Sheet1").Select
.Application.Range("A1").Select
.Application.Range(Selection, Selection.End(xlToRight)).Select
With .Application.Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
.Application.Selection.Font.Bold = True
.Application.ActiveWindow.SplitRow = 0.764705882352941
.Application.ActiveWindow.FreezePanes = True
End With
' AND HERE
------------------------------------------------------------------------

objWKB.Close savechanges:=True
objXL.Application.Quit

Set objActiveWkb = Nothing
Set objXL = Nothing
 
K

Klatuu

Try replacing this line:
.Application.Range(Selection, Selection.End(xlToRight)).Select
With This:
Selection.End(xlToRight).Select
No guarantees, but I don't see anything else obvious.
In fact, before I had it coded this way, sometimes it would go to the
correct row and sometimes it would not.
Let me know what happens.
 
P

PK

Klatuu - you are a GENIUS! While your latest suggestion did not work, you
had me going in all of the right directions.

I made the following change to my original code, and all is well with the
world!

CHANGED
..Application.Range("A1").Select and
..Application.Range(Selection, Selection.End(xlToRight)).Select

TO
..Application.Range("A1", .Application.Selection.End(xlToRight)).Select

THANKS A MILLION FOR YOUR HELP! :)
 
K

Klatuu

Great! Glad you got it. It is always hard to get "Air Code" to work right
the first time, sorry.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Control Excel from Access 4
Word macro that can call cells out of Excel for a find and replace 0
Opening an Excel file with a changing name 2
Creating Command Buttons from VBA - adding code 3
Programming interaction with Excel from Access 1
more excel automation trouble with ms access 1
Automation to Excel leaves Excel open until Access closed 4
Access automation leaves Excel open which in turn locks 2nd automation attempts 8

Top