Generate Excel from Access Problem

  • Thread starter Thread starter ML
  • Start date Start date
M

ML

Dim oAppE As Excel.Application, oWrkBk As Workbook, oWrkSh As Worksheet

Set oAppE = CreateObject("Excel.Application")
oAppE.Application.Visible = True

Set oWrkBk = oAppE.Workbooks.Open(To_Scratch) ' To_Scratch is a Path
etc
Set oWrkSh = oWrkBk.Worksheets(1)

GoSub Process_Formula ' creates spreadsheet, puts data in, puts
rules in and formats
' e.g.
oWrkSh.Range(BorderCells).Select
'
Selection.Font.Bold = True

oWrkBk.Save

Set oWrkSh = Nothing

oWrkBk.Close
Set oWrkBk = Nothing

oAppE.Application.Visible = False
oAppE.Quit
Set oAppE = Nothing


The above is called from an Access 2003 form to create and save a
spreadsheet.
It does it successfully, flashing past on the screen and finishes by saving
the spreadsheet
and returning to the calling screen.

If the process is repeated, it does it all again until the first formatting
statement
(as shown above). It sticks here.

If the spreadsheet is created and the Access application closed and then
reopened,
it will happily recreate and resave the spreadsheet or any other - and then
repeat the
above problem.

My current (unsatisfactory) work around, is to quit the Access application
after the
generation - not very elegant!

Does anybody have any ideas why I cannot repeat the above process
indefinitely?

TIA Michael
 
You're mixing Early Binding (e.g., "Dim oAppE As Excel.Application") and
Late Binding ("Set oAppE = CreateObject("Excel.Application")
") here; choose one or the other and stick with it. Also, you're using some
unqualified, not fully referenced objects in your code, which will confuse
ACCESS further because it will generate another connection to the EXCEL
application in order to handle this.

I don't know what "BorderCells" variable is? Do you set that somewhere else
in your code?

You may have other unqualified, not fully referenced objects in the "GoSub
Process_Formula" procedure, but you didn't post that code so we cannot tell;
it is clear that you're not passing any of the EXCEL objects to this process
though, so it's probable that you are creating more new connections to EXCEL
in this procedure.



I've modified your code for Early Binding (I prefer late binding), try this:


Dim oAppE As Excel.Application, oWrkBk As Excel.Workbook, _
oWrkSh As Excel.Worksheet

Set oAppE = New Excel.Application
oAppE.Application.Visible = True

Set oWrkBk = oAppE.Workbooks.Open(To_Scratch) ' To_Scratch is a Path
etc
Set oWrkSh = oWrkBk.Worksheets(1)

GoSub Process_Formula ' creates spreadsheet, puts data in, puts
rules in and formats
' e.g.
oWrkSh.Range(BorderCells).Font.Bold = True

oWrkBk.Save

Set oWrkSh = Nothing

oWrkBk.Close
Set oWrkBk = Nothing

oAppE.Application.Visible = False
oAppE.Quit
Set oAppE = Nothing
 
ML said:
Dim oAppE As Excel.Application, oWrkBk As Workbook, oWrkSh As Worksheet

Set oAppE = CreateObject("Excel.Application")
oAppE.Application.Visible = True

Set oWrkBk = oAppE.Workbooks.Open(To_Scratch) ' To_Scratch is a Path
etc
Set oWrkSh = oWrkBk.Worksheets(1)

GoSub Process_Formula ' creates spreadsheet, puts data in, puts
rules in and formats
' e.g.
oWrkSh.Range(BorderCells).Select
'
Selection.Font.Bold = True

oWrkBk.Save

Set oWrkSh = Nothing

oWrkBk.Close
Set oWrkBk = Nothing

oAppE.Application.Visible = False
oAppE.Quit
Set oAppE = Nothing


The above is called from an Access 2003 form to create and save a
spreadsheet.
It does it successfully, flashing past on the screen and finishes by saving
the spreadsheet
and returning to the calling screen.

If the process is repeated, it does it all again until the first formatting
statement
(as shown above). It sticks here.

If the spreadsheet is created and the Access application closed and then
reopened,
it will happily recreate and resave the spreadsheet or any other - and then
repeat the
above problem.

My current (unsatisfactory) work around, is to quit the Access application
after the
generation - not very elegant!

Does anybody have any ideas why I cannot repeat the above process
indefinitely?

TIA Michael
Click to expand...

The problem here, is that you're referring to an Excel property, without
"qualifying" it against it's parent object. That will most likely create
an extra instance of the automated application in memory (check Task
Manager), fail the second time it's run...

Replace

Selection.Font.Bold = True

with

oAppE.Selection.Font.Bold = True

Here's a bit more info
http://support.microsoft.com/default.aspx?kbid=178510
 
Thanks Ken,

I've changed the start and modified the select and bold lines.

The code now stops (2nd time around) just after another .select and setting.
***NOW FAILS HERE***
It finds the select empty, so cannot set the property as required.

I've enclosed the whole of the routine.

What is not being closed, un set from 1st to 2nd run, which causes the
2nd run to run out of resources - "too many selects" in a stack?
Is there an ".unselect" to use before the next .select ?

oAppE.Quit
Set oAppE = Nothing

seems pretty final to me!


TIA Michael

Private Sub cmdCreateFormula_Click()

Dim From_Template As String, To_Template As String, To_Scratch As String

Dim DB As Database, rs As DAO.Recordset, irec As Long

Dim sTrial_Code As String
Dim Emp As String, sSQL As String
Dim NextSheetNo As Integer

Dim i As Integer, ThisRow As Integer, MergeCells As String
Dim BorderCells As String
Dim jj As Integer, Letter As String, TestCells As String, RangeCells As
String, iRowCount As Integer
Dim lRawMaterialID As Integer, sUnit As String

Dim iSeedStartRow As Integer, iSeedEndRow As Integer, iLiquidStartRow As
Integer, iLiquidEndRow As Integer
Dim iPowderMixtureStartRow As Integer, iPowderMixtureEndRow As Integer,
iOtherStartRow As Integer, iOtherEndRow As Integer
Dim LastTableRowCount As Integer

Dim sSumSolidFormula As String, sSumSolidUsed As String, sSumSeedFormula
As String, sSumSeedUsed As String
Dim sSumLiquidFormula As String, sSumLiquidUsed As String,
sSumPowderMixtureFormula As String, sSumPowderMixtureUsed As String
Dim sSumOtherFormula As String, sSumOtherUsed As String

Set DB = CurrentDb()

sSQL = "SELECT Count(tblTrialFormulaLines.LineNo) AS CountOfLineNo " _
& "FROM tblTrialFormulaLines " _
& "Where tblTrialFormulaLines.ProjectNo = " & mlProjectNo & " " _
& "And tblTrialFormulaLines.SubProjectNo = " & mlSubProjectNo & " " _
& "And tblTrialFormulaLines.TrialNo = " & mlTrialNo & ";"
Set rs = DB.OpenRecordset(sSQL, dbOpenSnapshot)
irec = rs.RecordCount
If irec <= 0 Then
MsgBox "No Formula", 0, "Please Note"
Else
irec = rs(0)
End If
rs.Close
Set rs = Nothing

If irec <= 0 Then
DB.Close
Set DB = Nothing
Exit Sub
End If

sTrial_Code = mlProjectNo & "-" & Format(mlSubProjectNo, "00") & "-" &
Format(mlTrialNo, "000")

From_Template = sFormulaTemplatePath & "\Formula_Template.xls"
' To_Template = sTrialPath & "\" & sTrial_Code & "_Formula.xls"
To_Scratch = sScratchPath & "\" & sTrial_Code & "_Formula.xls"

DoCmd.SetWarnings False
' Kill To_Scratch
FileCopy From_Template, To_Scratch
DoCmd.SetWarnings True


Dim oAppE As Excel.Application, oWrkBk As Excel.Workbook, oWrkSh As
Excel.Worksheet

Set oAppE = New Excel.Application
oAppE.Application.Visible = True

Set oWrkBk = oAppE.Workbooks.Open(To_Scratch)
Set oWrkSh = oWrkBk.Worksheets(1)

GoSub Process_Formula

oWrkBk.Save

Set oWrkSh = Nothing

oWrkBk.Close
Set oWrkBk = Nothing

oAppE.Application.Visible = False
oAppE.Quit
Set oAppE = Nothing

DB.Close
Set DB = Nothing

' temporary until problem with repeat fixed
' DoCmd.Close
' DoCmd.Quit

Exit Sub

'------------------------------------------------------------------------------
Process_Formula:

' On Error GoTo 0

iSeedStartRow = 0
iSeedEndRow = 0
iLiquidStartRow = 0
iLiquidEndRow = 0
iPowderMixtureStartRow = 0
iPowderMixtureEndRow = 0
iOtherStartRow = 0
iOtherEndRow = 0

sSumSolidFormula = ""
sSumSolidUsed = ""

sSumSeedFormula = ""
sSumSeedUsed = ""
sSumLiquidFormula = ""
sSumLiquidUsed = ""
sSumPowderMixtureFormula = ""
sSumPowderMixtureUsed = ""
sSumOtherFormula = ""
sSumOtherUsed = ""

' fill worksheet

oWrkSh.Select

oWrkSh.Cells(2, "B") = Me.txtTrialFlavour
oWrkSh.Cells(4, "B") = Me.txtTrialExperimentalCode
oWrkSh.Cells(6, "B") = Me.txtTrialDate
oWrkSh.Cells(8, "B") = Me.txtTrialFinalApplication

iRowCount = 11

' seed section

oWrkSh.Cells(iRowCount, "D") = "Seed"
' make it bold and this line green

sSQL = "SELECT tblTrialFormulaLines.* FROM tblTrialFormulaLines " _
& "Where (((tblTrialFormulaLines.ProjectNo) = " & mlProjectNo & ") " _
& "And ((tblTrialFormulaLines.SubProjectNo) = " & mlSubProjectNo & ") "
_
& "And ((tblTrialFormulaLines.TrialNo) = " & mlTrialNo & ") " _
& "And ((tblTrialFormulaLines.FormulaSection) = '" & "Seed" & "')) " _
& "ORDER BY tblTrialFormulaLines.FormulaNo,
tblTrialFormulaLines.LineNo;"

Set rs = DB.OpenRecordset(sSQL, dbOpenSnapshot)
If rs.RecordCount > 0 Then
rs.MoveFirst
iSeedStartRow = iRowCount + 1
GoSub GetandPlace
iSeedEndRow = iRowCount
If iSeedStartRow = iSeedEndRow Then
sSumSeedFormula = "E" & CStr(iSeedStartRow)
sSumSeedUsed = "H" & CStr(iSeedStartRow)
Else
sSumSeedFormula = "E" & CStr(iSeedStartRow) & ":" & "E" &
CStr(iSeedEndRow)
sSumSeedUsed = "H" & CStr(iSeedStartRow) & ":" & "H" &
CStr(iSeedEndRow)
End If

iRowCount = iRowCount + 1
' oWrkSh.Cells(iRowCount, "D") = "Total of Seed"
' oWrkSh.Cells(iRowCount, "E").Formula = "=SUM(" & sSumSeedFormula &
")"
' oWrkSh.Cells(iRowCount, "H").Formula = "=SUM(" & sSumSeedUsed & ")"
End If

rs.Close
Set rs = Nothing

' liquid section

iRowCount = iRowCount + 1
oWrkSh.Cells(iRowCount, "D") = "Liquid"
' make it bold and this line green

sSQL = "SELECT tblTrialFormulaLines.* FROM tblTrialFormulaLines " _
& "Where (((tblTrialFormulaLines.ProjectNo) = " & mlProjectNo & ") " _
& "And ((tblTrialFormulaLines.SubProjectNo) = " & mlSubProjectNo & ") "
_
& "And ((tblTrialFormulaLines.TrialNo) = " & mlTrialNo & ") " _
& "And ((tblTrialFormulaLines.FormulaSection) = '" & "Liquid" & "')) "
_
& "ORDER BY tblTrialFormulaLines.FormulaNo,
tblTrialFormulaLines.LineNo;"

Set rs = DB.OpenRecordset(sSQL, dbOpenSnapshot)
If rs.RecordCount > 0 Then
rs.MoveFirst
iLiquidStartRow = iRowCount + 1
GoSub GetandPlace
iLiquidEndRow = iRowCount
If iLiquidStartRow = iLiquidEndRow Then
sSumLiquidFormula = "E" & CStr(iLiquidStartRow)
sSumLiquidUsed = "H" & CStr(iLiquidStartRow)
Else
sSumLiquidFormula = "E" & CStr(iLiquidStartRow) & ":" & "E" &
CStr(iLiquidEndRow)
sSumLiquidUsed = "H" & CStr(iLiquidStartRow) & ":" & "H" &
CStr(iLiquidEndRow)
End If

iRowCount = iRowCount + 1
' oWrkSh.Cells(iRowCount, "D") = "Total of Liquid"
' oWrkSh.Cells(iRowCount, "E").Formula = "=SUM(" & sSumLiquidFormula
& ")"
' oWrkSh.Cells(iRowCount, "H").Formula = "=SUM(" & sSumLiquidUsed &
")"
End If

rs.Close
Set rs = Nothing

' powder mixture section

iRowCount = iRowCount + 1
oWrkSh.Cells(iRowCount, "D") = "Powder Mixture"
' make it bold and this line green

sSQL = "SELECT tblTrialFormulaLines.* FROM tblTrialFormulaLines " _
& "Where (((tblTrialFormulaLines.ProjectNo) = " & mlProjectNo & ") " _
& "And ((tblTrialFormulaLines.SubProjectNo) = " & mlSubProjectNo & ") "
_
& "And ((tblTrialFormulaLines.TrialNo) = " & mlTrialNo & ") " _
& "And ((tblTrialFormulaLines.FormulaSection) = '" & "Powder Mixture" &
"')) " _
& "ORDER BY tblTrialFormulaLines.FormulaNo,
tblTrialFormulaLines.LineNo;"

Set rs = DB.OpenRecordset(sSQL, dbOpenSnapshot)
If rs.RecordCount > 0 Then
rs.MoveFirst
iPowderMixtureStartRow = iRowCount + 1
GoSub GetandPlace
iPowderMixtureEndRow = iRowCount

If iPowderMixtureStartRow = iPowderMixtureEndRow Then
sSumPowderMixtureFormula = "E" & CStr(iPowderMixtureStartRow)
sSumPowderMixtureUsed = "H" & CStr(iPowderMixtureStartRow)
Else
sSumPowderMixtureFormula = "E" & CStr(iPowderMixtureStartRow) &
":" & "E" & CStr(iPowderMixtureEndRow)
sSumPowderMixtureUsed = "H" & CStr(iPowderMixtureStartRow) & ":"
& "H" & CStr(iPowderMixtureEndRow)
End If

iRowCount = iRowCount + 1
oWrkSh.Cells(iRowCount, "D") = "Total of Powder Mixture"
oWrkSh.Cells(iRowCount, "E").Formula = "=SUM(" &
sSumPowderMixtureFormula & ")"
oWrkSh.Cells(iRowCount, "H").Formula = "=SUM(" &
sSumPowderMixtureUsed & ")"
oWrkSh.Cells(iRowCount, "F") = "Kg"
oWrkSh.Cells(iRowCount, "I") = "Kg"

' percentage powder mixture of all
oWrkSh.Cells(iRowCount, "G").Formula = "=E" & CStr(iRowCount) & "/E"
& CStr(10 + irec + 8)
oWrkSh.Cells(iRowCount, "J").Formula = "=H" & CStr(iRowCount) & "/H"
& CStr(10 + irec + 8)
End If

rs.Close
Set rs = Nothing

' other section - may not exist

sSQL = "SELECT tblTrialFormulaLines.* FROM tblTrialFormulaLines " _
& "Where (((tblTrialFormulaLines.ProjectNo) = " & mlProjectNo & ") " _
& "And ((tblTrialFormulaLines.SubProjectNo) = " & mlSubProjectNo & ") "
_
& "And ((tblTrialFormulaLines.TrialNo) = " & mlTrialNo & ") " _
& "And ((tblTrialFormulaLines.FormulaSection) = '" & "Other" & "')) " _
& "ORDER BY tblTrialFormulaLines.FormulaNo,
tblTrialFormulaLines.LineNo;"

Set rs = DB.OpenRecordset(sSQL, dbOpenSnapshot)
If rs.RecordCount > 0 Then
iRowCount = iRowCount + 1
oWrkSh.Cells(iRowCount, "D") = "Other"
' make it bold and this line green

rs.MoveFirst
iOtherStartRow = iRowCount + 1
GoSub GetandPlace
iOtherEndRow = iRowCount

If iOtherStartRow = iOtherEndRow Then
sSumOtherFormula = "E" & CStr(iOtherStartRow)
sSumOtherUsed = "H" & CStr(iOtherStartRow)
Else
sSumOtherFormula = "E" & CStr(iOtherStartRow) & ":" & "E" &
CStr(iOtherEndRow)
sSumOtherUsed = "H" & CStr(iOtherStartRow) & ":" & "H" &
CStr(iOtherEndRow)
End If

iRowCount = iRowCount + 1
' oWrkSh.Cells(iRowCount, "D") = "Total of Other"
' oWrkSh.Cells(iRowCount, "E").Formula = "=SUM(" & sSumOtherFormula &
")"
' oWrkSh.Cells(iRowCount, "H").Formula = "=SUM(" & sSumOtherUsed &
")"

End If

rs.Close
Set rs = Nothing

' all

iRowCount = iRowCount + 2
oWrkSh.Cells(iRowCount, "D") = "Total of all solid ingredients"

If sSumSolidFormula <> "" Then
sSumSolidFormula = Left$(sSumSolidFormula, Len(sSumSolidFormula) -
1)
sSumSolidUsed = Left$(sSumSolidUsed, Len(sSumSolidUsed) - 1)
oWrkSh.Cells(iRowCount, "E").Formula = "=SUM(" & sSumSolidFormula &
")"
oWrkSh.Cells(iRowCount, "F") = "Kg"
oWrkSh.Cells(iRowCount, "G") = 1 ' 100%
oWrkSh.Cells(iRowCount, "H").Formula = "=SUM(" & sSumSolidUsed & ")"
oWrkSh.Cells(iRowCount, "I") = "Kg"
oWrkSh.Cells(iRowCount, "J") = 1 ' 100%
End If

LastTableRowCount = iRowCount

If Nz(Me.txtTrialFormulatedByName, "") <> "" Then
iRowCount = iRowCount + 2
oWrkSh.Cells(iRowCount, "A") = "Formula By:"
oWrkSh.Cells(iRowCount, "B") = Me.txtTrialFormulatedByName
BorderCells = "A" & CStr(iRowCount) & ":B" & CStr(iRowCount)
oWrkSh.Range(BorderCells).Font.Bold = True
' oWrkSh.Range(BorderCells).Select
' Selection.Font.Bold = True
End If

If Nz(Me.txtTrialPreparedByName, "") <> "" Then
iRowCount = iRowCount + 2
oWrkSh.Cells(iRowCount, "A") = "Prepared By:"
oWrkSh.Cells(iRowCount, "B") = Me.txtTrialPreparedByName
BorderCells = "A" & CStr(iRowCount) & ":B" & CStr(iRowCount)
oWrkSh.Range(BorderCells).Font.Bold = True
' oWrkSh.Range(BorderCells).Select
' Selection.Font.Bold = True
End If

If Nz(Me.txtTaskCarriedOutByName1, "") <> "" And
Nz(Me.txtTaskActivityCarriedOutName1, "") <> "" Then
iRowCount = iRowCount + 2
oWrkSh.Cells(iRowCount, "A") = Me.txtTaskActivityCarriedOutName1 & "
By:"
oWrkSh.Cells(iRowCount, "B") = Me.txtTaskCarriedOutByName1
BorderCells = "A" & CStr(iRowCount) & ":B" & CStr(iRowCount)
oWrkSh.Range(BorderCells).Font.Bold = True
' oWrkSh.Range(BorderCells).Select
' Selection.Font.Bold = True
End If

If Nz(Me.txtTaskCarriedOutByName2, "") <> "" And
Nz(Me.txtTaskActivityCarriedOutName2, "") <> "" Then
iRowCount = iRowCount + 2
oWrkSh.Cells(iRowCount, "A") = Me.txtTaskActivityCarriedOutName2 & "
By:"
oWrkSh.Cells(iRowCount, "B") = Me.txtTaskCarriedOutByName2
BorderCells = "A" & CStr(iRowCount) & ":B" & CStr(iRowCount)
oWrkSh.Range(BorderCells).Font.Bold = True
' oWrkSh.Range(BorderCells).Select
' Selection.Font.Bold = True
End If

If Nz(Me.txtTaskCarriedOutByName3, "") <> "" And
Nz(Me.txtTaskActivityCarriedOutName3, "") <> "" Then
iRowCount = iRowCount + 2
oWrkSh.Cells(iRowCount, "A") = Me.txtTaskActivityCarriedOutName3 & "
By:"
oWrkSh.Cells(iRowCount, "B") = Me.txtTaskCarriedOutByName3
BorderCells = "A" & CStr(iRowCount) & ":B" & CStr(iRowCount)
oWrkSh.Range(BorderCells).Font.Bold = True
' oWrkSh.Range(BorderCells).Select
' Selection.Font.Bold = True
End If

If Nz(Me.txtTaskCarriedOutByName4, "") <> "" And
Nz(Me.txtTaskActivityCarriedOutName4, "") <> "" Then
iRowCount = iRowCount + 2
oWrkSh.Cells(iRowCount, "A") = Me.txtTaskActivityCarriedOutName4 & "
By:"
oWrkSh.Cells(iRowCount, "B") = Me.txtTaskCarriedOutByName4
BorderCells = "A" & CStr(iRowCount) & ":B" & CStr(iRowCount)
oWrkSh.Range(BorderCells).Font.Bold = True
' oWrkSh.Range(BorderCells).Select
' Selection.Font.Bold = True
End If

If Nz(Me.txtQualityBeadsKg, 0) <> 0 Then
oWrkSh.Cells(LastTableRowCount + 3, "D") = "Qualifying Beads"
oWrkSh.Cells(LastTableRowCount + 4, "D") = "Oversize Beads"
oWrkSh.Cells(LastTableRowCount + 5, "D") = "Undersize Beads + Dust"
oWrkSh.Cells(LastTableRowCount + 6, "D") = "Total Batch"
oWrkSh.Cells(LastTableRowCount + 3, "E") = Me.txtQualityBeadsKg
oWrkSh.Cells(LastTableRowCount + 4, "E") = Me.txtOversizeBeadsKg
oWrkSh.Cells(LastTableRowCount + 5, "E") =
Me.txtUndersizeBeadsandDustKg
oWrkSh.Cells(LastTableRowCount + 6, "E") = Nz(Me.txtQualityBeadsKg,
0) + Nz(Me.txtOversizeBeadsKg, 0) + Nz(Me.txtUndersizeBeadsandDustKg, 0)
BorderCells = "E" & CStr(LastTableRowCount + 3) & ":E" &
CStr(LastTableRowCount + 6)
oWrkSh.Range(BorderCells).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
oWrkSh.Cells(LastTableRowCount + 3, "F") = "Kg"
oWrkSh.Cells(LastTableRowCount + 4, "F") = "Kg"
oWrkSh.Cells(LastTableRowCount + 5, "F") = "Kg"
oWrkSh.Cells(LastTableRowCount + 6, "F") = "Kg"
BorderCells = "F" & CStr(LastTableRowCount + 3) & ":F" &
CStr(LastTableRowCount + 6)
oWrkSh.Range(BorderCells).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
BorderCells = "D" & CStr(LastTableRowCount + 3) & ":F" &
CStr(LastTableRowCount + 6)
oWrkSh.Range(BorderCells).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlThin
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlThin
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlThick
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).Weight = xlThick
End If

If Nz(Me.txtTrialDissolution1, "") <> "" Then
oWrkSh.Cells(LastTableRowCount + 8, "E") = "1"
oWrkSh.Cells(LastTableRowCount + 8, "F") = "2"
oWrkSh.Cells(LastTableRowCount + 8, "G") = "3"
oWrkSh.Cells(LastTableRowCount + 8, "H") = "Avg"
oWrkSh.Cells(LastTableRowCount + 9, "D") = "Dissolution Time"
oWrkSh.Cells(LastTableRowCount + 9, "E") = Me.txtTrialDissolution1
oWrkSh.Cells(LastTableRowCount + 9, "F") = Me.txtTrialDissolution2
oWrkSh.Cells(LastTableRowCount + 9, "G") = Me.txtTrialDissolution3
oWrkSh.Cells(LastTableRowCount + 9, "H") = Me.txtTrialDissolutionAVG
BorderCells = "E" & CStr(LastTableRowCount + 8) & ":H" &
CStr(LastTableRowCount + 8)
oWrkSh.Range(BorderCells).Select
With Selection
.HorizontalAlignment = xlRight ' ***NOW FAILS
HERE***
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
BorderCells = "E" & CStr(LastTableRowCount + 9) & ":H" &
CStr(LastTableRowCount + 9)
oWrkSh.Range(BorderCells).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
BorderCells = "D" & CStr(LastTableRowCount + 8) & ":H" &
CStr(LastTableRowCount + 9)
oWrkSh.Range(BorderCells).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlThin
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlThin
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlThick
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).Weight = xlThick
End If

BorderCells = "A11" & ":J" & CStr(LastTableRowCount)
oWrkSh.Range(BorderCells).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlThick
Selection.Borders(xlEdgeLeft).ColorIndex = xlAutomatic

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.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

If iSeedStartRow > 0 Then
BorderCells = "A" & CStr(iSeedStartRow - 1) & ":J" &
CStr(iSeedStartRow - 1)
oWrkSh.Range(BorderCells).Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 35
.PatternColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlThick
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
End With
End If

If iLiquidStartRow > 0 Then
BorderCells = "A" & CStr(iLiquidStartRow - 1) & ":J" &
CStr(iLiquidStartRow - 1)
oWrkSh.Range(BorderCells).Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 35
.PatternColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlThick
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
End With
End If

If iPowderMixtureStartRow > 0 Then
BorderCells = "A" & CStr(iPowderMixtureStartRow - 1) & ":J" &
CStr(iPowderMixtureStartRow - 1)
oWrkSh.Range(BorderCells).Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 35
.PatternColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlThick
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
End With
End If

If iOtherStartRow <> 0 Then
BorderCells = "A" & CStr(iOtherStartRow - 1) & ":J" &
CStr(iOtherStartRow - 1)
oWrkSh.Range(BorderCells).Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 35
.PatternColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlThick
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
End With
End If

BorderCells = "A" & CStr(iPowderMixtureEndRow + 1) & ":J" &
CStr(LastTableRowCount)
oWrkSh.Range(BorderCells).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlThin
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlThin
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlThick
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).Weight = xlThick

' oWrkSh.Cells(LastTableRowCount, "J") = " "


Return

Leave:
MsgBox "Error End", 0, "Problem"
Return

'----------------------------------------------------------------------------------------------------------------

GetandPlace:

Do Until rs.EOF
iRowCount = iRowCount + 1
lRawMaterialID = rs!RawMaterialID
sUnit = Nz(DLookup("[RawMaterialUnit]", "tblRawMaterials",
"[RawMaterialID] = " & lRawMaterialID), "Kg")
oWrkSh.Cells(iRowCount, "A") = Nz(rs!MaterialCode, "")
oWrkSh.Cells(iRowCount, "B") = Nz(rs!SupplierAbbreviation, "")
oWrkSh.Cells(iRowCount, "C") = Nz(rs!MaterialBatch, "")
If rs!FormulaNo <> 1 Then
oWrkSh.Cells(iRowCount, "D") = Nz(rs!ProductDescription, "") & "
(" & CStr(rs!FormulaNo) & ")"
Else
oWrkSh.Cells(iRowCount, "D") = Nz(rs!ProductDescription, "")
End If
oWrkSh.Cells(iRowCount, "E") = Nz(rs!FormulaQty, 0)
oWrkSh.Cells(iRowCount, "F") = sUnit
oWrkSh.Cells(iRowCount, "H") = Nz(rs!UsedQty, 0)
oWrkSh.Cells(iRowCount, "I") = sUnit
If rs!Water = False Then
sSumSolidFormula = sSumSolidFormula & "E" & CStr(iRowCount) &
","
sSumSolidUsed = sSumSolidUsed & "H" & CStr(iRowCount) & ","
oWrkSh.Cells(iRowCount, "G").Formula = "=E" & CStr(iRowCount) &
"/E" & CStr(10 + irec + 8)
oWrkSh.Cells(iRowCount, "J").Formula = "=H" & CStr(iRowCount) &
"/H" & CStr(10 + irec + 8)
End If
rs.MoveNext
Loop

Return


End Sub
 
Way down in your code, you have this block:

oWrkSh.Range(BorderCells).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Note that Selection is not qualified/fully referenced. I'd change this block
to this:

With oWrkSh.Range(BorderCells)
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With



Same situation for this block of code a little further down:

oWrkSh.Range(BorderCells).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


Then you have this big block that is unqualified:

oWrkSh.Range(BorderCells).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlThin
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlThin
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlThick
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).Weight = xlThick


And this block later on:

oWrkSh.Range(BorderCells).Select
With Selection
.HorizontalAlignment = xlRight ' ***NOW FAILS
HERE***
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With


and there are many more such examples in your code. All references to EXCEL
objects must be fully qualified and fully referenced through already opened
objects.

--

Ken Snell
<MS ACCESS MVP>



ML said:
Thanks Ken,

I've changed the start and modified the select and bold lines.

The code now stops (2nd time around) just after another .select and
setting.
***NOW FAILS HERE***
It finds the select empty, so cannot set the property as required.

I've enclosed the whole of the routine.

What is not being closed, un set from 1st to 2nd run, which causes the
2nd run to run out of resources - "too many selects" in a stack?
Is there an ".unselect" to use before the next .select ?

oAppE.Quit
Set oAppE = Nothing

seems pretty final to me!
Click to expand...


< code snipped >
 
Thanks Ken. I'll change the code. Roy Vidar has also suggested similar
changes and referred to a Microsoft Note concerning my problem.

I derived the code by executing a macro in Excel and looking at the results.
I used a similar approach in an earlier system, but must have executed the
program only once.

It was quite perplexing when a routine worked perfectly and then failed part
way through a rerun!

Michael
 
Thanks Roy. I'll change the code. Ken Snell has also suggested similar
changes .

Please note my reply to him

Michael
 
Back
Top