D
dchman
I inherited an Access application which is used to prepare a powerpoint
presentation through VBA. Once the user picks a presentation and clicks go,
a powerpoint application is started and a template presentation loaded.
Through VBA, the slides in the presentation are updated with current data,
including charts embedded within the presentation. More often than not,
somewhere in the middle of the process, while attempting to update a chart on
a slide, error 462 will occur in one of the subs. If I trap the error
outside of the sub and just resume, the process will continue without the
error.
Anyone have any ideas on why the error is occurring and how to prevent it?
Oh yeah, one more clue? On my development machine, the error doesn't occur.
The error only seems to occur when the app is deployed to a server, which is
access through a citrix client. Some sample code is given below.
thanks
Dan
(also posted
on the frmPP
Private sub cmdGo_Click()
on error goto err_Proc
call initPP()
call LoadPresTemplate()
DoSlide1
..... call other subs for other slides
pptPres.Save
pptApp.WindowsState = ppWindowMinimized
MsgBox "done"
set pptApp = nothing
exit_Proc:
exit sub
err_Proc:
dim errNum as long
errnum = err.number
Select Case (errNum)
Case 462
resume
Case Else
MsgBox(......)
Resume exit_Proc
End Select
end sub
Private DoSlide1()
dim curChart as Chart
dim curData as DataSheet
Set curSlide = pptApp.Presentations(pptPres.Name).Slides(1)
curSlide.Select
curSlide.Shapes(1).TextFrame.TextRange.text = "testslideone"
Set curChart = curSlide.Shapes(4).OLEFormat.Object
Set curData = curChart.Application.DataSheet
curData.Range("01").Value = "your score"
curChart.Axes(xlValue, xlPrimary).MaximumScale = 7
ChartBarFormat curChart, 1
curChart.Application.Update
set curChart = nothing
set curData = nothing
end Sub
' in a module
Declarations
public pptApp as PowerPoint.Application
public pptPres as PowerPoint.Presentation
public curSlide as PowerPoint.Slide
Public Sub InitPP()
set pptApp = new PowerPoint.Application
pptApp.Activate
end sub
Public LoadPresTemplate(strTemplateName as string, strFileName as string)
Set pptPres = pptApp.Presenations.Open(strTemplateName)
pptPres.SaveAs strFileName
end sub
--
dchman
I did more digging - put Break on Error on VB code - this is one of the real
subs from the app - the error occurs most often in the middle of the
indicated loop -
Private Sub BuildCrossTabByCats(iFirmID As Integer, TypeID As Long)
'Declare object variables
Dim db As Database
Dim rsData As Recordset
Dim rsCats As Recordset
Dim rsPos As Recordset
Dim theChart As graph.Chart
Dim theData As graph.DataSheet
'Declare variables
Dim iCount As Integer
Dim sVal As String
Dim iSlideCount As Integer
Dim theCharts(0 To 2) As graph.Chart
Dim x As Long, i As Long, posCount As Long, iDataCount As Long
Set db = CurrentDb()
On Error Resume Next
db.TableDefs.Delete "Crosstab Avg of Cat Avg for " &
kCrossTabStrings(TypeID) & ""
On Error GoTo 0
db.QueryDefs("Make Crosstab For " &
kCrossTabStrings(TypeID)).Parameters(0).Value = iFirmID
db.QueryDefs("Make Crosstab For " & kCrossTabStrings(TypeID)).Execute
Set rsData = db.OpenRecordset("SELECT * FROM [Crosstab Avg of Cat Avg
for " & kCrossTabStrings(TypeID) & "] ORDER BY Value")
Set rsCats = db.OpenRecordset("SELECT ShortName, AbrvName FROM [Question
Category] WHERE NOT CatID = 9 AND NOT CatID = 11 AND NOT CatID = 15 ORDER BY
ItemNumber")
Set rsPos = db.OpenRecordset("Position")
rsPos.Index = "PositionID"
For i = 0 To 2
Set theSlide =
pptApp.Presentations(pptPres.Name).Slides(kCrossTabOffsets(TypeID) + i)
theSlide.Select
Set theCharts(i) =
pptApp.Presentations(pptPres.Name).Slides(theSlide.Name).Shapes(3).OLEFormat.Object
theCharts(i).Axes(graph.xlValue,
graph.xlPrimary).TickLabels.NumberFormat = "General"
theCharts(i).HasLegend = True
Next i
posCount = 1
rsData.MoveFirst
Do While rsData.EOF = False
For iCount = 1 To 12
**** THE ERROR OCCURS OFTEN IN THIS LOOP ON THE theDataRange STATEMENTS -
NOT THE FIRST TIME THROUGH THOUGH
If iCount = 1 Or iCount = 5 Or iCount = 9 Then
iDataCount = 1
Set theSlide =
pptApp.Presentations(pptPres.Name).Slides(kCrossTabOffsets(TypeID) + ((iCount
- 1) / 5))
theSlide.Select
If Not (theChart Is Nothing) Then theChart.Application.Update
Set theChart = theCharts(((iCount - 1) / 5))
Set theData = theChart.Application.DataSheet
theData.Range("0" & posCount).Value = rsData!Label.Value
End If
theData.Range(Chr(iDataCount + 64) & "0").Value =
rsCats.Fields("ShortName").Value
If IsNull(rsData.Fields(rsCats.Fields("AbrvName").Value)) Then
theData.Range(Chr(iDataCount + 64) & posCount).Value = 0
Else
theData.Range(Chr(iDataCount + 64) & posCount).Value =
Round(rsData.Fields(rsCats.Fields("AbrvName").Value).Value, 2)
End If
rsCats.MoveNext
iDataCount = iDataCount + 1
Next iCount
posCount = posCount + 1
rsData.MoveNext
rsCats.MoveFirst
Loop
For i = 0 To 2
Set theChart = theCharts(i)
For x = 1 To theChart.SeriesCollection.count
ChartBarFormat theChart, x, Array(55, 44, 2, 15, 1, 54)
With theChart.SeriesCollection(x)
.ApplyDataLabels (graph.xlDataLabelsShowValue)
.DataLabels.Font.Size = "12"
End With
Next x
If theChart.SeriesCollection.count = 1 Then
theChart.ChartGroups(1).GapWidth = 180
End If
theChart.Application.Update
Next i
If Check5.Value Then PresReload 4
end_Sub:
Set db = Nothing
Set rsData = Nothing
Set rsCats = Nothing
Set rsPos = Nothing
Set theChart = Nothing
Set theData = Nothing
End Sub
presentation through VBA. Once the user picks a presentation and clicks go,
a powerpoint application is started and a template presentation loaded.
Through VBA, the slides in the presentation are updated with current data,
including charts embedded within the presentation. More often than not,
somewhere in the middle of the process, while attempting to update a chart on
a slide, error 462 will occur in one of the subs. If I trap the error
outside of the sub and just resume, the process will continue without the
error.
Anyone have any ideas on why the error is occurring and how to prevent it?
Oh yeah, one more clue? On my development machine, the error doesn't occur.
The error only seems to occur when the app is deployed to a server, which is
access through a citrix client. Some sample code is given below.
thanks
Dan
(also posted
on the frmPP
Private sub cmdGo_Click()
on error goto err_Proc
call initPP()
call LoadPresTemplate()
DoSlide1
..... call other subs for other slides
pptPres.Save
pptApp.WindowsState = ppWindowMinimized
MsgBox "done"
set pptApp = nothing
exit_Proc:
exit sub
err_Proc:
dim errNum as long
errnum = err.number
Select Case (errNum)
Case 462
resume
Case Else
MsgBox(......)
Resume exit_Proc
End Select
end sub
Private DoSlide1()
dim curChart as Chart
dim curData as DataSheet
Set curSlide = pptApp.Presentations(pptPres.Name).Slides(1)
curSlide.Select
curSlide.Shapes(1).TextFrame.TextRange.text = "testslideone"
Set curChart = curSlide.Shapes(4).OLEFormat.Object
Set curData = curChart.Application.DataSheet
curData.Range("01").Value = "your score"
curChart.Axes(xlValue, xlPrimary).MaximumScale = 7
ChartBarFormat curChart, 1
curChart.Application.Update
set curChart = nothing
set curData = nothing
end Sub
' in a module
Declarations
public pptApp as PowerPoint.Application
public pptPres as PowerPoint.Presentation
public curSlide as PowerPoint.Slide
Public Sub InitPP()
set pptApp = new PowerPoint.Application
pptApp.Activate
end sub
Public LoadPresTemplate(strTemplateName as string, strFileName as string)
Set pptPres = pptApp.Presenations.Open(strTemplateName)
pptPres.SaveAs strFileName
end sub
--
dchman
I did more digging - put Break on Error on VB code - this is one of the real
subs from the app - the error occurs most often in the middle of the
indicated loop -
Private Sub BuildCrossTabByCats(iFirmID As Integer, TypeID As Long)
'Declare object variables
Dim db As Database
Dim rsData As Recordset
Dim rsCats As Recordset
Dim rsPos As Recordset
Dim theChart As graph.Chart
Dim theData As graph.DataSheet
'Declare variables
Dim iCount As Integer
Dim sVal As String
Dim iSlideCount As Integer
Dim theCharts(0 To 2) As graph.Chart
Dim x As Long, i As Long, posCount As Long, iDataCount As Long
Set db = CurrentDb()
On Error Resume Next
db.TableDefs.Delete "Crosstab Avg of Cat Avg for " &
kCrossTabStrings(TypeID) & ""
On Error GoTo 0
db.QueryDefs("Make Crosstab For " &
kCrossTabStrings(TypeID)).Parameters(0).Value = iFirmID
db.QueryDefs("Make Crosstab For " & kCrossTabStrings(TypeID)).Execute
Set rsData = db.OpenRecordset("SELECT * FROM [Crosstab Avg of Cat Avg
for " & kCrossTabStrings(TypeID) & "] ORDER BY Value")
Set rsCats = db.OpenRecordset("SELECT ShortName, AbrvName FROM [Question
Category] WHERE NOT CatID = 9 AND NOT CatID = 11 AND NOT CatID = 15 ORDER BY
ItemNumber")
Set rsPos = db.OpenRecordset("Position")
rsPos.Index = "PositionID"
For i = 0 To 2
Set theSlide =
pptApp.Presentations(pptPres.Name).Slides(kCrossTabOffsets(TypeID) + i)
theSlide.Select
Set theCharts(i) =
pptApp.Presentations(pptPres.Name).Slides(theSlide.Name).Shapes(3).OLEFormat.Object
theCharts(i).Axes(graph.xlValue,
graph.xlPrimary).TickLabels.NumberFormat = "General"
theCharts(i).HasLegend = True
Next i
posCount = 1
rsData.MoveFirst
Do While rsData.EOF = False
For iCount = 1 To 12
**** THE ERROR OCCURS OFTEN IN THIS LOOP ON THE theDataRange STATEMENTS -
NOT THE FIRST TIME THROUGH THOUGH
If iCount = 1 Or iCount = 5 Or iCount = 9 Then
iDataCount = 1
Set theSlide =
pptApp.Presentations(pptPres.Name).Slides(kCrossTabOffsets(TypeID) + ((iCount
- 1) / 5))
theSlide.Select
If Not (theChart Is Nothing) Then theChart.Application.Update
Set theChart = theCharts(((iCount - 1) / 5))
Set theData = theChart.Application.DataSheet
theData.Range("0" & posCount).Value = rsData!Label.Value
End If
theData.Range(Chr(iDataCount + 64) & "0").Value =
rsCats.Fields("ShortName").Value
If IsNull(rsData.Fields(rsCats.Fields("AbrvName").Value)) Then
theData.Range(Chr(iDataCount + 64) & posCount).Value = 0
Else
theData.Range(Chr(iDataCount + 64) & posCount).Value =
Round(rsData.Fields(rsCats.Fields("AbrvName").Value).Value, 2)
End If
rsCats.MoveNext
iDataCount = iDataCount + 1
Next iCount
posCount = posCount + 1
rsData.MoveNext
rsCats.MoveFirst
Loop
For i = 0 To 2
Set theChart = theCharts(i)
For x = 1 To theChart.SeriesCollection.count
ChartBarFormat theChart, x, Array(55, 44, 2, 15, 1, 54)
With theChart.SeriesCollection(x)
.ApplyDataLabels (graph.xlDataLabelsShowValue)
.DataLabels.Font.Size = "12"
End With
Next x
If theChart.SeriesCollection.count = 1 Then
theChart.ChartGroups(1).GapWidth = 180
End If
theChart.Application.Update
Next i
If Check5.Value Then PresReload 4
end_Sub:
Set db = Nothing
Set rsData = Nothing
Set rsCats = Nothing
Set rsPos = Nothing
Set theChart = Nothing
Set theData = Nothing
End Sub