T
TexKiernan
I have seen several posts regarding this error but haven't found the answer.
I wrote (very poorly) a code to copy a recordset to a spreadsheet (works
great), then conditionally format the sheet (error here). I hit an error 91
every other time I execute the code from the button. I can run it all day
inside the module with no problem. Here is code;
Function makexl()
Dim xlwkb As Excel.Workbook
Dim xlwks As Excel.Worksheet
Dim xlApp As Excel.Application
Dim objRST As Recordset
Dim lvlColumn As Long
Dim MyDB As Database
Dim fs As Object
Set MyDB = CurrentDb
Set fs = CreateObject("Scripting.FileSystemObject")
Set objRST = MyDB.OpenRecordset("6MosNPFDProjection_Crosstab",
dbOpenForwardOnly)
Set xlApp = CreateObject("excel.application")
Set xlwkb = xlApp.Workbooks.Add
Set xlwks = xlApp.Worksheets("Sheet1")
If fs.FileExists("\\fs-back-891-01\372 rcg\rssp\6MosNPFDProjection.xls") =
True Then
Kill ("\\fs-back-891-01\372 rcg\rssp\6MosNPFDProjection.xls")
Else:
End If
xlApp.Visible = True
With xlwkb
For lvlColumn = 0 To objRST.Fields.Count - 1
xlwks.Cells(1, lvlColumn + 1).Value = objRST.Fields(lvlColumn).Name
Next
xlwks.Range(xlwks.Cells(1, 1), _
xlwks.Cells(1, objRST.Fields.Count)).Font.Bold = True
With xlwks
.Range("A2").CopyFromRecordset objRST
.Rows("1").Select
Selection.NumberFormat = "dd-mmm-yy" '<====ERROR HERE
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlBottom
Selection.WrapText = False
Selection.Orientation = 90
Selection.AddIndent = False
Selection.IndentLevel = 0
Selection.ShrinkToFit = False
Selection.ReadingOrder = xlContext
Selection.MergeCells = False
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
.Columns("A:B").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
With Selection.Interior
.ColorIndex = 15
.PatternColorIndex = xlAutomatic
End With
Range("C2").Select
ActiveWindow.FreezePanes = True
.Cells.Select
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, Formula1:="=""L"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
With Selection.FormatConditions(1).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.FormatConditions(1).Interior.ColorIndex = 5
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, Formula1:="=""T"""
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
Selection.FormatConditions(2).Interior.ColorIndex = 3
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, Formula1:="=""L"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
With Selection.FormatConditions(1).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.FormatConditions(1).Interior.ColorIndex = 5
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, Formula1:="=""T"""
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
With Selection.FormatConditions(2).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(2).Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(2).Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(2).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.FormatConditions(2).Interior.ColorIndex = 3
Cells.EntireColumn.AutoFit
Range("K7").Select
End With
End With
xlwkb.SaveAs Filename:="\\fs-back-891-01\372 rcg\rssp\6MosNPFDProjection.xls"
xlApp.Application.Quit
Rem Set xlwks = Nothing
Rem Set xlApp = Nothing
Rem Set objRST = Nothing
Rem Set xlwkb = Nothing
Rem Set fs = Nothing
Rem Set MyDB = Nothing
End Function
If I remove the offending line, it just moves down to the next one.
Thanks in advance!
I wrote (very poorly) a code to copy a recordset to a spreadsheet (works
great), then conditionally format the sheet (error here). I hit an error 91
every other time I execute the code from the button. I can run it all day
inside the module with no problem. Here is code;
Function makexl()
Dim xlwkb As Excel.Workbook
Dim xlwks As Excel.Worksheet
Dim xlApp As Excel.Application
Dim objRST As Recordset
Dim lvlColumn As Long
Dim MyDB As Database
Dim fs As Object
Set MyDB = CurrentDb
Set fs = CreateObject("Scripting.FileSystemObject")
Set objRST = MyDB.OpenRecordset("6MosNPFDProjection_Crosstab",
dbOpenForwardOnly)
Set xlApp = CreateObject("excel.application")
Set xlwkb = xlApp.Workbooks.Add
Set xlwks = xlApp.Worksheets("Sheet1")
If fs.FileExists("\\fs-back-891-01\372 rcg\rssp\6MosNPFDProjection.xls") =
True Then
Kill ("\\fs-back-891-01\372 rcg\rssp\6MosNPFDProjection.xls")
Else:
End If
xlApp.Visible = True
With xlwkb
For lvlColumn = 0 To objRST.Fields.Count - 1
xlwks.Cells(1, lvlColumn + 1).Value = objRST.Fields(lvlColumn).Name
Next
xlwks.Range(xlwks.Cells(1, 1), _
xlwks.Cells(1, objRST.Fields.Count)).Font.Bold = True
With xlwks
.Range("A2").CopyFromRecordset objRST
.Rows("1").Select
Selection.NumberFormat = "dd-mmm-yy" '<====ERROR HERE
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlBottom
Selection.WrapText = False
Selection.Orientation = 90
Selection.AddIndent = False
Selection.IndentLevel = 0
Selection.ShrinkToFit = False
Selection.ReadingOrder = xlContext
Selection.MergeCells = False
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
.Columns("A:B").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
With Selection.Interior
.ColorIndex = 15
.PatternColorIndex = xlAutomatic
End With
Range("C2").Select
ActiveWindow.FreezePanes = True
.Cells.Select
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, Formula1:="=""L"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
With Selection.FormatConditions(1).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.FormatConditions(1).Interior.ColorIndex = 5
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, Formula1:="=""T"""
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
Selection.FormatConditions(2).Interior.ColorIndex = 3
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, Formula1:="=""L"""
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
With Selection.FormatConditions(1).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.FormatConditions(1).Interior.ColorIndex = 5
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, Formula1:="=""T"""
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
With Selection.FormatConditions(2).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(2).Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(2).Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.FormatConditions(2).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.FormatConditions(2).Interior.ColorIndex = 3
Cells.EntireColumn.AutoFit
Range("K7").Select
End With
End With
xlwkb.SaveAs Filename:="\\fs-back-891-01\372 rcg\rssp\6MosNPFDProjection.xls"
xlApp.Application.Quit
Rem Set xlwks = Nothing
Rem Set xlApp = Nothing
Rem Set objRST = Nothing
Rem Set xlwkb = Nothing
Rem Set fs = Nothing
Rem Set MyDB = Nothing
End Function
If I remove the offending line, it just moves down to the next one.
Thanks in advance!