رسم نمودار در Excel توسط ویژوال بیسیک

[BadSector]

من با این کد از توی vb یه نمودار توی Excel رسم میکنم اما اگر دوباره روی دکمه رسم نمودار کلیک کنم دفعه دوم اررور میده :عصبانی++:
کسی میتونه بگه چه کارش باید بکنم ؟

یادآوری: رفرنس Microsoft Excel 12 Object Library رو به پروژه اضافه کنید.



Private Sub Command1_Click()
Dim objExcel As Excel.Application
Dim new_chart As Chart
Dim new_book As Workbook
Dim active_sheet As Worksheet
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set new_book = objExcel.Workbooks.Add()
Set active_sheet = new_book.Sheets(1)
active_sheet.Cells(1, 2) = "10"
active_sheet.Cells(1, 3) = "11"
active_sheet.Cells(1, 3) = "12"
active_sheet.Cells(1, 4) = "13"
active_sheet.Cells(1, 5) = "20"
active_sheet.Cells(1, 6) = "14"
active_sheet.Cells(1, 7) = "15"
active_sheet.Cells(1, 8) = "16"
Set new_chart = Charts.Add()
With new_chart
.ChartType = xlColumnClustered
.SeriesCollection(1).ApplyDataLabels
.SetSourceData Source:=Range("Sheet1!$B$1:$H$2")
.Location Where:=xlLocationAsObject, Name:=active_sheet.Name
End With
active_sheet.Shapes(1).Top = 50
active_sheet.Shapes(1).Left = 100
active_sheet.Shapes(1).Width = 600
active_sheet.Shapes(1).Height = 400
End Sub

[sanaz2007]

سلام .از رفرنس Microsoft Excel 10 Object Library استفاده کنید

Private Sub Command1_Click()
Dim varNum As Long
Dim objExcel As excel.Application
Dim objWorkbook As excel.Workbook
Dim objWorksheet As excel.Worksheet
'Start the excel COM and make it visible.
Set objExcel = GetObject("", "excel.application")
'Set objExcel = excel.Application ' Seems to cause a memory leak
objExcel.Visible = True

'Start a workbook.
Set objWorkbook = objExcel.Workbooks.Add
'Turn off the alerts, otherwise user will have to confirm my actions.
objExcel.DisplayAlerts = False
'Depending on the users excel's settings, there could be many worksheet when starting a workbook.
'Ensure there is only one worksheet.
Do While objWorkbook.Worksheets.Count > 1
Set objWorksheet = objWorkbook.Worksheets.Item(objWorkbook.Worksheets .Count)
objWorksheet.Delete
Loop
'Set objWorksheet to the remaining worksheet.
Set objWorksheet = ActiveSheet
'Rename the sheet to Results.
objWorksheet.Name = "Results"
'Headers
objWorksheet.Cells(1, 1) = "Blah Blah Blah Analytic Labs"
objWorksheet.Cells(1, 1).Font.Bold = True
objWorksheet.Cells(2, 1) = "Experiment Name"
objWorksheet.Cells(2, 1).Font.Bold = True
objWorksheet.Cells(2, 3) = "Trial Number"
objWorksheet.Cells(2, 3).Font.Bold = True
objWorksheet.Cells(2, 5) = "Batch Number"
objWorksheet.Cells(2, 5).Font.Bold = True
objWorksheet.Cells(3, 1) = " " & Now
objWorksheet.Cells(3, 1).Font.Bold = True

'Results
objWorksheet.Cells(5, 1) = "Results"
objWorksheet.Cells(5, 1).Font.Bold = True

'General info
objWorksheet.Cells(8, 2) = "Number of Samples:"
objWorksheet.Cells(9, 2) = "Sample Amount (ug):"
objWorksheet.Cells(10, 2) = " "
objWorksheet.Cells(11, 2) = "Mobile Phase:"
objWorksheet.Cells(12, 2) = "Wash Phase:"
'Data
objWorksheet.Cells(14, 1) = "Data"
objWorksheet.Cells(14, 1).Font.Bold = True
objWorksheet.Cells(14, 3) = "Data A"
objWorksheet.Cells(15, 3) = "(ug/s)"
objWorksheet.Cells(14, 4) = "Data B"
objWorksheet.Cells(15, 4) = "(ug/s)"
objWorksheet.Cells(16, 2) = "1)"
objWorksheet.Cells(17, 2) = "2)"
objWorksheet.Cells(18, 2) = "3)"
objWorksheet.Cells(19, 2) = "4)"
objWorksheet.Cells(20, 2) = "5)"
objWorksheet.Cells(21, 2) = "6)"
objWorksheet.Cells(22, 2) = "7)"
objWorksheet.Cells(23, 2) = "8)"
objWorksheet.Cells(24, 2) = "9)"
objWorksheet.Cells(25, 2) = "10)"
'Enter data
'Put your own data here, load a file, or something
'Data Set A
objWorksheet.Cells(16, 4) = "111"
objWorksheet.Cells(17, 4) = "222"
objWorksheet.Cells(18, 4) = "333"
objWorksheet.Cells(19, 4) = "444"
objWorksheet.Cells(20, 4) = "555"
objWorksheet.Cells(21, 4) = "666"
objWorksheet.Cells(22, 4) = "777"
objWorksheet.Cells(23, 4) = "888"
objWorksheet.Cells(24, 4) = "999"
objWorksheet.Cells(25, 4) = "1111"
'Data Set B
objWorksheet.Cells(25, 3) = "111"
objWorksheet.Cells(24, 3) = "222"
objWorksheet.Cells(23, 3) = "333"
objWorksheet.Cells(22, 3) = "444"
objWorksheet.Cells(21, 3) = "555"
objWorksheet.Cells(20, 3) = "666"
objWorksheet.Cells(19, 3) = "777"
objWorksheet.Cells(18, 3) = "888"
objWorksheet.Cells(17, 3) = "999"
objWorksheet.Cells(16, 3) = "1111"
'Draw Chart with the data
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets("Results").Range("A14:D25"), PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Results"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = objWorksheet.Cells(1, 1) ' Title
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Sample" ' X-Axis
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Amount " & objWorksheet.Cells(15, 3) ' Y-Axis
End With
ActiveSheet.ChartObjects("Chart 1").Activate
With ActiveSheet.Shapes("Chart 1")
.Left = 240.75
.Top = 178.5
End With

'Turn back on alerts so user will be notified to save on exit.
' objExcel.DisplayAlerts = True
'Free up memory, otherwise there will be a memory leak.
Set objExcel = Nothing
Set objWorksheet = Nothing
Set objWorkbook = Nothing
End Sub

[BadSector]

سلام
رفرنس Microsoft Excel 10 Object Library توی رفرنسهای من نبود !!!!!!
با همون Microsoft Excel 12 Object Library تست کردم همون مشکل کد منو داشت ...

[sanaz2007]

منم Microsoft Excel 12 Object Library رو ندارم .نمیدونم چه مشکلی داره؟!

[BadSector]

شما يه بار دكمه رو فشار بده نمودار رسم بشه بعد اكسل رو ببند حالا تو تسك منيجر تب براسز نكاه كني اكسل تو ليست هست
حالا اكه دوباره باتن رو فشار بدي ارور ميده مكر قبلش اكسل رو از تسك منيجر ببندي!
براي شما اين طوري نيست?

[sanaz2007]

شما يه بار دكمه رو فشار بده نمودار رسم بشه بعد اكسل رو ببند حالا تو تسك منيجر تب براسز نكاه كني اكسل تو ليست هست
حالا اكه دوباره باتن رو فشار بدي ارور ميده مكر قبلش اكسل رو از تسك منيجر ببندي!
براي شما اين طوري نيست?

سلام .دوست عزیز متوجه منظورتون نشدم.کدی که شما گذاشتید تست کردم ولی ارور داد.

[BadSector]

سلام
مشکلم اینه
1.اول رفرنس Microsoft Excel 12 Object Library رو به پروژه اضافه میکنم.
2.بعد کدهای بالا رو کپی میکنم.
3.بعد از کلیک کردن رو باتن نمودار رسم میشه.
4.در عین حال که فایل اکسل قبلی باز هست دوباره باتن رو فشار میدم دفعه دوم روی این خط اررور میده.

active_sheet.Shapes(1).Top = 50

[BadSector]

کسی تست نکرده ؟؟؟
من خودم فکرمیکنم مشکل توی این قسمت از کد هستش

Set new_chart = Charts.Add()
With new_chart
.ChartType = xlColumnClustered
.SeriesCollection(1).ApplyDataLabels
.SetSourceData Source:=Range("Sheet1!$B$1:$H$2")
.Location Where:=xlLocationAsObject, Name:=active_sheet.Name
End With
active_sheet.Shapes(1).Top = 50
active_sheet.Shapes(1).Left = 100
active_sheet.Shapes(1).Width = 600
active_sheet.Shapes(1).Height = 400
End Sub

باید Location مشکل داشته باشه...
چون بار دوم چارت رو توی همون Excel اولی رسم میکنه برای همین اررور میده ...

[sanaz2007]

متاسفم.منم این مشکلو دارم:ناراحت: