Access VBA to format Excel

[Pendragon]

I have an Access application which exports data to an Excel template and
formats the template. I did have this working at one point but now it fails
with an Error 91 - Object variable or With block variable not set. Maybe I'm
missing something simple but any ideas would be helpful.

The code is very lengthy so I'm copying in to the point of failure. I have
double-checked all variable definitions and matched WITH-END WITH pairs.

Thanks for any help or ideas.

Dim sSQL As String
Dim db As Database
Dim rs As Recordset
Dim objExcel As Object
Dim objWkbk As Object
Dim stPathName As String
Dim stFileName As String, stNewName As String
Dim stDocName As String, stSheetName As String
Dim stTemplate As String, stYear As String, stMonth As String, stDay As String
Dim MyDate As Date
Dim CID As Integer, icolumn As Integer, TID As Integer
Dim stCell As String, NewCell As String
Dim CName As String, R1R2 As String, SK1SK2 As String, LJ1LJ2 As String
Dim OSVal As Integer
Dim RG1 As String, RG2 As String
Dim MFID As Integer
Dim MTimeID As Integer

stPathName = "c:\RefOnCourt\"
stTemplate = "c:\RefOnCourt\DailyGrid.xlt"
MyDate = Me.cboTournDay
stYear = Str(Year(MyDate))
If Month(MyDate) < 10 Then
stMonth = "0" & Trim(Str(Month(MyDate)))
Else
stMonth = Trim(Str(Month(MyDate)))
End If
If Day(MyDate) < 10 Then
stDay = "0" And Trim(Str(Day(MyDate)))
Else
stDay = Trim(Str(Day(MyDate)))
End If

stFileName = "DailyGrid" & Trim(stYear) & stMonth & stDay
stSheetName = "DailyGrid" & Trim(stYear) & stMonth & stDay


stFileName = stPathName & stFileName & ".xls"

CID = -1
TID = -1

Set db = CurrentDb
sSQL = "SELECT qryT_ViewGrid.CourtID, qryT_ViewGrid.CourtName,
adm_MatchTimes.MatchTimeID, qryT_ViewGrid.MatchTime,
qryT_ViewGrid.MatchFormatID, qryT_ViewGrid.R1R2, qryT_ViewGrid.LJ1LJ2,
qryT_ViewGrid.SK1SK2 " & _
"FROM qryT_ViewGrid INNER JOIN adm_MatchTimes ON
qryT_ViewGrid.MatchTimeID = adm_MatchTimes.MatchTimeID " & _
"ORDER BY qryT_ViewGrid.CourtID, adm_MatchTimes.MatchTimeID;"

Set rs = db.OpenRecordset(sSQL)
stCell = "B2"
rs.MoveFirst

With objWkbk
.Sheets("Sheet1").Select
.Sheets("Sheet1").Activate
.Sheets("Sheet1").Name = stSheetName
icolumn = 0

.ActiveSheet.Range("A1").Activate
.ActiveSheet.Range("A1").Value = "Officials Assignments - " &
Format(MyDate, "dddd, mmmm dd, yyyy")
.ActiveSheet.Range("A1").Font.Bold = True

Do While Not rs.EOF
icolumn = icolumn + 1
CName = rs("CourtName")

With .ActiveSheet
.Range(stCell).Select
.Range(stCell).Activate
End With

With .ActiveSheet
ActiveCell.Offset(0, icolumn).Select ****FAILS HERE*****
ActiveCell.Offset(0, icolumn).Activate

With ActiveCell
.Value = CName
.HorizontalAlignment = xlcenter
.Font.Bold = True
End With

.......remaining code......

 

[Joel]

Your loop may be going past the last column. Can't tell because you only
posted part of the code. I made some changes to the code to make it easier
to debug and to prevent errors from occuring when switching between the tohe
database and the wroksheet. Avoid using Activate and Select because it will
cause prblems when the focus of the window changes between the database and
excel worksheet.


Dim sSQL As String
Dim db As Database
Dim rs As Recordset
Dim objExcel As Object
Dim objWkbk As Object
Dim stPathName As String
Dim stFileName As String, stNewName As String
Dim stDocName As String, stSheetName As String
Dim stTemplate As String, stYear As String, stMonth As String, stDay As String
Dim MyDate As Date
Dim CID As Integer, icolumn As Integer, TID As Integer
Dim stCell As String, NewCell As String
Dim CName As String, R1R2 As String, SK1SK2 As String, LJ1LJ2 As String
Dim OSVal As Integer
Dim RG1 As String, RG2 As String
Dim MFID As Integer
Dim MTimeID As Integer

stPathName = "c:\RefOnCourt\"
stTemplate = "c:\RefOnCourt\DailyGrid.xlt"
MyDate = Me.cboTournDay
stYear = Str(Year(MyDate))
If Month(MyDate) < 10 Then
stMonth = "0" & Trim(Str(Month(MyDate)))
Else
stMonth = Trim(Str(Month(MyDate)))
End If
If Day(MyDate) < 10 Then
stDay = "0" And Trim(Str(Day(MyDate)))
Else
stDay = Trim(Str(Day(MyDate)))
End If

stFileName = "DailyGrid" & Trim(stYear) & stMonth & stDay
stSheetName = "DailyGrid" & Trim(stYear) & stMonth & stDay


stFileName = stPathName & stFileName & ".xls"

CID = -1
TID = -1

Set db = CurrentDb
sSQL = "SELECT qryT_ViewGrid.CourtID, qryT_ViewGrid.CourtName,
adm_MatchTimes.MatchTimeID, qryT_ViewGrid.MatchTime,
qryT_ViewGrid.MatchFormatID, qryT_ViewGrid.R1R2, qryT_ViewGrid.LJ1LJ2,
qryT_ViewGrid.SK1SK2 " & _
"FROM qryT_ViewGrid INNER JOIN adm_MatchTimes ON
qryT_ViewGrid.MatchTimeID = adm_MatchTimes.MatchTimeID " & _
"ORDER BY qryT_ViewGrid.CourtID, adm_MatchTimes.MatchTimeID;"

Set rs = db.OpenRecordset(sSQL)
stCell = "B2"
rs.MoveFirst

With objWkbk
set objSht = .Sheets("Sheet1")
objSht.Name = stSheetName
icolumn = 0

with objSht
.Range("A1").Value = "Officials Assignments - " & _
Format(MyDate, "dddd, mmmm dd, yyyy")
.Range("A1").Font.Bold = True

set StCell = .Range(stCell)

Do While Not rs.EOF
icolumn = icolumn + 1
CName = rs("CourtName")


with StCell


With .Offset(0, icolumn)
.Value = CName
.HorizontalAlignment = xlcenter
.Font.Bold = True
End With