Re: Generate Excel from Access Problem

Tech-Archive recommends: Fix windows errors by optimizing your registry

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.Work***

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 work***

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


.

Quantcast