I am opening excel by Access. It seems to work the first time I run
the function to create the xl file, but then never releases excel
even tho it does look like it does becuase the application
disappears. If I look at task manager, it's still there. The
rerunning it gives wierd behavior.
The code is below:
Function make_xl()
Dim splitarray() As String
Dim ctr As Integer
Dim theDate As String
Dim theWB As String
Dim rs As DAO.Recordset
Dim db As Database
Set db = CurrentDb
Set rs = db.OpenRecordset("qry_mtd_flash")
splitarray = Split(CStr(Date) & "/", "/")
For ctr = 0 To UBound(splitarray) - 1
theDate = theDate & splitarray(ctr) & "_"
Next
theDate = Left(theDate, (Len(theDate) - 1))
Dim theXLS As Excel.Application
Set theXLS = New Excel.Application
theXLS.AskToUpdateLinks = False
theXLS.CalculationInterruptKey = xlEscKey
'theXLS.ScreenUpdating = False
theXLS.DisplayAlerts = False
theXLS.EnableCancelKey = xlInterrupt
theXLS.SheetsInNewWorkbook = 1
theXLS.Workbooks.Add
theWB = theXLS.Workbooks(Workbooks.Count).Name
theXLS.Workbooks(theWB).Activate
theXLS.Visible = True
theXLS.Workbooks(theWB).Activate
theXLS.Workbooks(theWB).Sheets(1).Select
theXLS.Workbooks(theWB).Sheets(1).Activate
theXLS.Workbooks(theWB).Sheets(1).Range("A1").Select
theXLS.Workbooks(theWB).Sheets(1).Range("A1").Activate
'ActiveCell.FormulaR1C1 = "Region"
Cells(1, 1).Value = "Region"
Range("B1").Select
ActiveCell.FormulaR1C1 = "District"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Store"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Store Name"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Proj MTD"
Range("F1").Select
ActiveCell.FormulaR1C1 = "LY MTD"
Range("G1").Select
ActiveCell.FormulaR1C1 = "TY MTD"
Range("I1").Select
ActiveCell.FormulaR1C1 = "% To Proj Overall"
Range("H1").Select
ActiveCell.FormulaR1C1 = "% to LY Overall"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Trans WTD"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Proj WTD"
Columns("F:F").Select
ActiveCell.FormulaR1C1 = "LY WTD"
Range("G1").Select
ActiveCell.FormulaR1C1 = "TY WTD"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Units WTD"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Hours WTD"
Range("N1").Select
ActiveCell.FormulaR1C1 = "$ Sq FT"
Range("O1").Select
ActiveCell.FormulaR1C1 = "UPT"
Range("O1:Q1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("O2").Select
ActiveCell.FormulaR1C1 = "TY"
Range("P2").Select
ActiveCell.FormulaR1C1 = "LY"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "% Chg"
Range("R1:T1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("R1:T1").Select
ActiveCell.FormulaR1C1 = "ADS"
Range("R2").Select
ActiveCell.FormulaR1C1 = "TY"
Range("S2").Select
ActiveCell.FormulaR1C1 = "LY"
Range("T2").Select
ActiveCell.FormulaR1C1 = "% Chg"
Range("U1:W1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("U1:W1").Select
ActiveCell.FormulaR1C1 = "DPH"
Range("U1:W1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("U2").Select
ActiveCell.FormulaR1C1 = "TY"
Range("V2").Select
ActiveCell.FormulaR1C1 = "LY"
Range("W2").Select
ActiveCell.FormulaR1C1 = "% Chg"
Range("X1").Select
ActiveCell.FormulaR1C1 = "Rtn % WTD"
Range("A1:X2").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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("O2:Q2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
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 = xlThick
.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
Range("R2:T2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
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 = xlThick
.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
Range("U2:W2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
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 = xlThick
.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
Range("A1:X2").Select
Selection.Interior.ColorIndex = 36
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Selection.Columns.AutoFit
'Exit Function
With ActiveSheet.PageSetup
.LeftMargin = 5600
.RightMargin = 5600
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 1200
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 93
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("A3").Select
ctr = 3
While Not rs.EOF
Cells(ctr, 1).Value = Trim(rs(10)) & " " & Trim(rs
(8)) 'division & region
Cells(ctr, 2).Value = Trim(rs(9))
ctr = ctr + 1
rs.MoveNext
Wend
Cells.Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 6
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Columns.AutoFit
theXLS.Visible = True
theXLS.ActiveWorkbook.SaveAs ("C:\FLASH_" & theDate
& ".xls"), , , , , , , xlLocalSessionChanges
theXLS.ActiveWorkbook.Close (1)
theXLS.Quit
Set theXLS = Nothing
End Function
------------------------ Yahoo! Groups Sponsor --------------------~-->
<font face=arial size=-1><a
href="http://us.ard.yahoo.com/SIG=12hgb28n0/M=362131.6882499.7825260.1510227/D=groups/S=1705115370:TM/Y=YAHOO/EXP=1124150110/A=2889191/R=0/SIG=10r90krvo/*http://www.thebeehive.org
">Get Bzzzy! (real tools to help you find a job) Welcome to the Sweet Life
- brought to you by One Economy</a>.</font>
--------------------------------------------------------------------~->
Please zip all files prior to uploading to Files section.
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/AccessDevelopers/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
