Chart creation in Shared Workbook

[BigDaddy01]

Hello,

I have a Userform that generates a Chart on a sheet, then using the method of creating a GIF file from that Chart, vba then places the GIF file into a Image place holder on the Userform. However, when the workbook is Shared, creating charts is not possible. To get around this I turn off sharing while the chart is being generated, then turn on sharing once the operation is complete. I can only use this method if no one else has the workbook open and do not prefer to do it this way. I want to pass the chart to another workbook called "TempChartWB.xlsx" and create the GIF file from the temporary workbook. Is there a way to modify the following code to do this?

I also attached a screen shot of the Userform below.

Private Sub cbGetChart_Click()
If txbBinNumber1.Text = "" Then
MsgBox "Please Enter a Bin Number", vbInformation, "Store Keeper"
txbBinNumber1.SetFocus
 Exit Sub
 End If
'Turn off WORKBOOK SHARING so chart can be created
If ActiveWorkbook.MultiUserEditing Then
        Application.DisplayAlerts = False
        ActiveWorkbook.ExclusiveAccess
        Application.DisplayAlerts = True
End If

'Get the year for which the chart is to be generated
Dim ListYear As Integer
ListYear = cmbYear.ListIndex
Sheet19.Range("E1").Value = DateAdd("yyyy",[ListYear], Sheet19.Range("D1").Value)
 
'Declaration
 Dim Mychart As Chart
 Dim ChartData1 As Range
 Dim ChartData2 As Range
 Dim ChartIndex As Integer
 Dim ChartName1 As String
 Dim ChartName2 As String
 Dim PartType1 As Range
 Dim PartType2 As Range
 Dim CostUnits1 As String
 Dim CostUnits2 As String
 Dim ws As Worksheet
 Set ws = Worksheets("Sheet19")
 
 'Activate Sheet 19
 Worksheets("Sheet19").Activate
Set ChartData1 = ActiveSheet.Range("SheetData1")
Set ChartData2 = ActiveSheet.Range("SheetData2")
ChartName1 = txbBinNumber1.Value
ChartName2 = txbBinNumber2.Value

Application.ScreenUpdating = False

'Write the values in textboxes to cells on sheet19
  ws.Cells(2, 6).Value = Me.txbBinNumber1
  ws.Cells(3, 6).Value = Me.txbBinNumber2
  
'Write the value of cell S2 in sheet19 to textbox
  txbSumRng1.Text = Sheets("sheet19").Range("S2")
'Look up the cost of the part and calculate to usage cost
  If txbBinNumber1.Value > "" Then
  CostUnits1 = Application.WorksheetFunction.VLookup(txbBinNumber1.Value, Sheets("Sheet1").Range("Sheet1Rng"), 14, False)
  txbCostRng1.Value = "$" & CostUnits1 * txbSumRng1.Value
  End If
'Look up the cost of the part and calculate to usage cost
  txbSumRng2.Text = Sheets("sheet19").Range("S3")
  If txbBinNumber2.Value > "" Then
  CostUnits2 = Application.WorksheetFunction.VLookup(txbBinNumber2.Value, Sheets("Sheet1").Range("Sheet1Rng"), 14, False)
  txbCostRng2.Value = "$" & CostUnits2 * txbSumRng2.Value
  End If
  
'Pick the chart type to be displayed and place it on the active sheet 19
If OptionButton1 = True Then
Set Mychart = ActiveSheet.Shapes.AddChart(xlBar).Chart
End If

If OptionButton2 = True Then
Set Mychart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
End If

If OptionButton3 = True Then
Set Mychart = ActiveSheet.Shapes.AddChart(xl3DColumnClustered).Chart
End If

On Error Resume Next
'Create the chart
 Mychart.SeriesCollection.NewSeries
 Mychart.SeriesCollection(1).Name = ChartName1
 Mychart.SeriesCollection(1).Values = ChartData1
 Mychart.SeriesCollection(1).XValues = ActiveSheet.Range("Month")
 Mychart.ChartTitle.Caption = "Sign Out Part Frequency"
 Mychart.Parent.Width = 570
 Mychart.Parent.Height = 250
 Set PartType1 = [Bin_Type_LBL]
 frmChartStats.Label1.Caption = Application.WorksheetFunction.VLookup(txbBinNumber1, PartType1, 3, False)
 
If txbBinNumber2 <> "" Then

On Error Resume Next

 Mychart.SeriesCollection.NewSeries
 Mychart.SeriesCollection(2).Name = ChartName2
 Mychart.SeriesCollection(2).Values = ChartData2
 Set PartType2 = [Bin_Type_LBL]
 frmChartStats.Label2.Caption = Application.WorksheetFunction.VLookup(txbBinNumber2, PartType2, 3, False)
End If


'Create a GIF image of the chart
Dim imageName As String
 imageName = Application.DefaultFilePath & Application.PathSeparator & "TempChart.gif"
 
 Mychart.Export Filename:=imageName, FilterName:="GIF"
'Delete the chart from Sheet 19
 ActiveSheet.ChartObjects(1).Delete
 
 Application.ScreenUpdating = True
'Load the GIF image into a image place holder on the userform
 frmChartStats.Image1.Picture = LoadPicture(imageName)
'
'Turn on WORKBOOK SHARING
  If Not ActiveWorkbook.MultiUserEditing Then
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs ActiveWorkbook.Name, accessmode:=xlShared
        Application.DisplayAlerts = True
End If
 

End Sub

Frequency Chart.jpg


Thanks for the help!

BigD

[BigDaddy01]

Anyone????