P
Phil Stanton
Trying to open Excel fom a command button on an Access form to retrieve and
process data to produce charts.
If I open Excel directly everything is fine without the Stop instruction
If I open Excel by pushing the button on the Access form the data loads OK
but then the code keeps giving errors "Object Variable or With Block
Variable not set", this error occuring in the GetSeriesData(Sht) function,
but I don'r think the error is there
Here is the code
If I have the Stop instruction, everything works perfectly, if not I get the
error.
Any ideas please. Is it something to do with the data not being completely
loaded
Thanks
Phil
Private Sub Workbook_Open()
Dim Sht As Worksheet
Dim i As Integer
On Error GoTo WorkBook_Err
If ActiveWorkbook.Names.Count > 0 Then
For i = 1 To ActiveWorkbook.Names.Count
ActiveWorkbook.Names(i).Delete ' Clear any DBs
Next i
End If
Call GetAccess
Stop '
**********************************************
' Process each sheet
For Each Sht In ThisWorkbook.Worksheets
If Sht.Name <> "Linked Data" Then
Sht.Visible = xlSheetHidden
Call ChangeChartBg(Sht) ' Get latest plan
Call GetSeriesData(Sht) ' Load series and labels
Call ExportChart(Sht) ' Output chart as GIF file
Sht.Visible = xlSheetVisible
End If
Next Sht
ActiveWorkbook.Save
Exit Sub
WorkBook_Err:
If Err = 1004 Then
MsgBox "Excel sheet not saved", vbInformation
Else
MsgBox Err & " " & Err.Description
End If
End Sub
Function GetAccess()
'
' Macro1 Macro
' Macro recorded 26/03/2008 by Phil Stanton
'
Dim MDBName As String, DefaultDirectory As String, SQLStg As String
On Error GoTo GetAccess_Err
Worksheets("Linked Data").Activate
With ActiveSheet
MDBName = .Range("A1")
CheckFile:
If Dir(MDBName) = "" Then ' Not found
MDBName = Application.GetOpenFilename("Access Database ,*.mde",
, "Where is the Club Database?")
If MsgBox("Do you want to use this database in future?",
vbQuestion + vbYesNo) = vbYes Then
.Range("A1") = MDBName
End If
End If
End With
'
' Clear Cells
ActiveSheet.Range("A2:H300").ClearContents
SQLStg = "SELECT DISTINCT TypeOfSpace, Space, SpaceAndName, XPos, YPos,
XLabelPosition, YLabelPosition, LabelAngle "
SQLStg = SQLStg & "FROM QSpaceAllocation ORDER BY TypeOfSpace, Space"
DefaultDirectory = Left(MDBName, InStrRev(MDBName, "\"))
With ActiveSheet.QueryTables.Add(Connection:=Array(Array("ODBC;DSN=MS
Access Database;"), _
Array("DBQ=" & MDBName & ";"), _
Array("DefaultDir=" & DefaultDirectory & ";DriverId=25;"), _
Array("FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("A2"))
.CommandText = Array(SQLStg)
.Name = "Query from MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
Exit Function
GetAccess_Err:
Stop
If Err = 12 Then
ThisWorkbook.Close , False
Else
MsgBox Err.Description
End If
End Function
process data to produce charts.
If I open Excel directly everything is fine without the Stop instruction
If I open Excel by pushing the button on the Access form the data loads OK
but then the code keeps giving errors "Object Variable or With Block
Variable not set", this error occuring in the GetSeriesData(Sht) function,
but I don'r think the error is there
Here is the code
If I have the Stop instruction, everything works perfectly, if not I get the
error.
Any ideas please. Is it something to do with the data not being completely
loaded
Thanks
Phil
Private Sub Workbook_Open()
Dim Sht As Worksheet
Dim i As Integer
On Error GoTo WorkBook_Err
If ActiveWorkbook.Names.Count > 0 Then
For i = 1 To ActiveWorkbook.Names.Count
ActiveWorkbook.Names(i).Delete ' Clear any DBs
Next i
End If
Call GetAccess
Stop '
**********************************************
' Process each sheet
For Each Sht In ThisWorkbook.Worksheets
If Sht.Name <> "Linked Data" Then
Sht.Visible = xlSheetHidden
Call ChangeChartBg(Sht) ' Get latest plan
Call GetSeriesData(Sht) ' Load series and labels
Call ExportChart(Sht) ' Output chart as GIF file
Sht.Visible = xlSheetVisible
End If
Next Sht
ActiveWorkbook.Save
Exit Sub
WorkBook_Err:
If Err = 1004 Then
MsgBox "Excel sheet not saved", vbInformation
Else
MsgBox Err & " " & Err.Description
End If
End Sub
Function GetAccess()
'
' Macro1 Macro
' Macro recorded 26/03/2008 by Phil Stanton
'
Dim MDBName As String, DefaultDirectory As String, SQLStg As String
On Error GoTo GetAccess_Err
Worksheets("Linked Data").Activate
With ActiveSheet
MDBName = .Range("A1")
CheckFile:
If Dir(MDBName) = "" Then ' Not found
MDBName = Application.GetOpenFilename("Access Database ,*.mde",
, "Where is the Club Database?")
If MsgBox("Do you want to use this database in future?",
vbQuestion + vbYesNo) = vbYes Then
.Range("A1") = MDBName
End If
End If
End With
'
' Clear Cells
ActiveSheet.Range("A2:H300").ClearContents
SQLStg = "SELECT DISTINCT TypeOfSpace, Space, SpaceAndName, XPos, YPos,
XLabelPosition, YLabelPosition, LabelAngle "
SQLStg = SQLStg & "FROM QSpaceAllocation ORDER BY TypeOfSpace, Space"
DefaultDirectory = Left(MDBName, InStrRev(MDBName, "\"))
With ActiveSheet.QueryTables.Add(Connection:=Array(Array("ODBC;DSN=MS
Access Database;"), _
Array("DBQ=" & MDBName & ";"), _
Array("DefaultDir=" & DefaultDirectory & ";DriverId=25;"), _
Array("FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Range("A2"))
.CommandText = Array(SQLStg)
.Name = "Query from MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=True
End With
Exit Function
GetAccess_Err:
Stop
If Err = 12 Then
ThisWorkbook.Close , False
Else
MsgBox Err.Description
End If
End Function