Access ADP VBA code works first time. Does not work if run again (1 Viewer)

ak_ls

Registered User.
Local time
Yesterday, 16:44
Joined
Oct 18, 2008
Messages
44
In Access ADP project, I am trying to copy an Excel Chart to a JPG file using the VBA code. This code runs for first time after opening the Access project but gives error if rerun. The error occurs at the following line in Sub CreateJPG.

ActiveChart.ChartArea.Select


The error number is o and description is blank.

Please help to locate the source of error. This code is yet not fully written /optimised and is in proof of conecpt stage.

Thanks
Ashok

'The following is the main routine.

Sub CopyExcelChartToJPGFile()
Dim YN As String
Dim MyExcel As New Excel.Application
Dim MyWorkBook As Workbook
Dim MySheet1 As Worksheet
Dim I, J, OKCan, ChartsCount As Integer
Dim SheetName, FileName, JPGFileName, JPGFileFolderPathName, SQLStr, MsgText, ActiveChartName As String
On Error GoTo Err1
OKCan = MsgBox("You are about to create jpg files of the charts on the worksheet: " & SheetName & Chr(10) & Chr(10) & "Please confirm ?", vbOKCancel)
If OKCan = vbCancel Then
If MyExcel Is Nothing Then
Else
Set MyExcel = Nothing
End If
MsgBox "You have cancelled the creation of jpg files."
Exit Sub
End If
JPGFileFolderPathName = "D:\Dashboard\Test\"
FileName = "D:\Dashboard\Dashboardsv141.7.xls"
SheetName = "Finance"
CellRange = "B3" & ":" & "D4"
MyExcel.Workbooks.Open FileName
I = MyExcel.Workbooks.Count
Set MyWorkBook = MyExcel.Workbooks(1)

MySheetNo = GetSheetNoFromName(MyWorkBook, "TempWork")
Set MySheet1 = MyWorkBook.Sheets(MySheetNo)

MySheetNo = GetSheetNoFromName(MyWorkBook, SheetName)
If MySheetNo < 1 Then
MsgBox ("Sheet " & SheetName & " not found in the Workbook.")
MyWorkBook.Close
If MyExcel Is Nothing Then
Else
Set MyExcel = Nothing
End If
Exit Sub
End If

' MyExcel.Visible = True

MySheetNo = GetSheetNoFromName(MyWorkBook, SheetName)
If MySheetNo > 0 Then
JPGFileName = SheetName & "Chart01"
Call CreateJPG(MyWorkBook, MySheetNo, MySheet1, CellRange, JPGFileFolderPathName, JPGFileName)
End If

If MySheet1 Is Nothing Then
Else
Set MySheet1 = Nothing
End If
MyWorkBook.Close SaveChanges:=False
If MyExcel Is Nothing Then
Else
Set MyExcel = Nothing
End If
Exit Sub
Err1:
MsgBox "Error No: " & Err.Number & Chr(10) & Err.Description & Chr(10) & "Error Location: " & ErrorLocation & " in Sub PictureExport of Module CopyExcelChartsToJPGFiles."
If MySheet1 Is Nothing Then
Else
Set MySheet1 = Nothing
End If
MyWorkBook.Close SaveChanges:=False
If MyExcel Is Nothing Then
Else
Set MyExcel = Nothing
End If
End Sub


'Error occurs in this routine which is called in the main routine.

Sub CreateJPG(ByRef MyWorkBook As Workbook, ByVal MySheetNo As Integer, ByRef MySheet1 As Worksheet, CellRange, ByVal JPGFileFolderPathName As String, ByVal JPGFileName As String)
Dim TempChart, MsgText, Picture2Export As String
Dim PicWidth, PicHeight As Long
Dim MySheet As Worksheet
Dim MyChart As Chart
Dim I, ChartsCount As Integer
On Error GoTo Err1
If (MyWorkBook Is Nothing) Or (MySheetNo < 1) Or (MySheet1 Is Nothing) Or IsEmpty(JPGFileFolderPathName) Or IsEmpty(JPGFileName) Then
MsgBox "Invalid value of parameters passed to Sub CreateJPG." & Chr(10) & "JPG not created."
Exit Sub
End If

'Copy a Range as picture onto "TempWork" sheet
Set MySheet = MyWorkBook.Sheets(MySheetNo)
MySheet.Select
MySheet.Range(CellRange).CopyPicture Appearance:=xlScreen, Format:=xlPicture
MySheet1.Select
MySheet1.Range("A1").Select
MySheet1.Paste

Picture2Export = MySheet1.Shapes(1).Name
PicHeight = MySheet1.Shapes(1).Height
PicWidth = MySheet1.Shapes(1).Width

'Add a temporary chart in sheet1
ChartsCount = MyWorkBook.Charts.Count
MyWorkBook.Charts.Add
TempChart = MyWorkBook.Charts(1).Name
Set MyChart = MyWorkBook.Charts(1)
ChartsCount = MyWorkBook.Charts.Count

'Move the added chart to "TempWork" sheet
MyWorkBook.Charts(1).Location WHERE:=xlLocationAsObject, Name:="TempWork"
I = MySheet1.Shapes.Count

'Copy the picture to clipboard
MySheet1.Range("A30").Select
MySheet1.Shapes(1).Select
MySheet1.Shapes(1).Copy

'Patse the picture to chart area
MySheet1.ChartObjects(1).Activate
ActiveChart.ChartArea.Select 'This line gives error on rerun. :eek::confused::mad:
ActiveChart.Paste

'Export the picture to a file
ActiveChart.Export FileName:=JPGFileFolderPathName & JPGFileName & ".jpg", FilterName:="jpg"

'Cut Chart and Picture objects
ActiveChart.ChartArea.ClearContents
ChartsCount = MyWorkBook.Charts.Count
I = MySheet1.Shapes.Count
MySheet1.ChartObjects(1).Cut
For I = 1 To MySheet1.ChartObjects.Count
MySheet1.ChartObjects(I).Cut
Next I
For I = 1 To MySheet1.Shapes.Count
MySheet1.Shapes(I).Cut
Next I

If MyChart Is Nothing Then
Else
Set MyChart = Nothing
End If
If MySheet Is Nothing Then
Else
Set MySheet = Nothing
End If
Exit Sub
Err1:
On Error Resume Next
MsgBox "Error No: " & Err.Number & Chr(10) & Err.Description & Chr(10) & "Error Location: " & ErrorLocation & " in Sub CreateJPG of Module CopyExcelChartsToJPGFiles."
If MyChart Is Nothing Then
Else
Set MyChart = Nothing
End If
If MySheet Is Nothing Then
Else
Set MySheet = Nothing
End If
End Sub



Function GetSheetNoFromName(ByRef MyWorkBook As Workbook, ByVal MySheetName As String) As Integer
Dim I, J As Integer
Dim MySheet As Worksheet
I = MyWorkBook.Sheets.Count
J = 0
GetSheetNoFromName = 0
Do While J < I
J = J + 1
Set MySheet = MyWorkBook.Sheets(J)
If MySheet.Name = MySheetName Then
GetSheetNoFromName = J
J = I + 100
End If
Loop
End Function
 

jal

Registered User.
Local time
Yesterday, 16:44
Joined
Mar 30, 2007
Messages
1,709
The only thing I can think of is to fully qualify EVERYTHING related to Excel - you will have to examine your code VERY carefully to make sure you don't overlook any qualifiers. For example this line:

Appearance:=xlScreen, Format:=xlPicture

should "probably" be (I'm not sure since I don't do much Excel interop) this:

Appearance:=Excel.xlScreen, Format:=Excel.xlPicture

For more info on using qualifiers, do a google on this error msg:

"The remote server machine does not exist or is unavailable"
 

boblarson

Smeghead
Local time
Yesterday, 16:44
Joined
Jan 12, 2001
Messages
32,068
Yes, qualify everything. Usually I use the application object:

Dim xlApp As Excel.Application

then when you refer to an ACTIVE object you qualify:

xlApp.ActiveChart.ChartArea.Select
 

ak_ls

Registered User.
Local time
Yesterday, 16:44
Joined
Oct 18, 2008
Messages
44
Thanks and regards to jal and boblarson.

Qualifying has resolved the problem.

Ashok
 

boblarson

Smeghead
Local time
Yesterday, 16:44
Joined
Jan 12, 2001
Messages
32,068
Thanks for posting back with your success. :)
 

Users who are viewing this thread

Top Bottom