用VB中的控件显示Excel中的图表

发布网友发布时间：2022-05-18 20:47

共1个回答

热心网友时间：2023-11-01 23:43

Function Save_Excel_Data() As Boolean
Save_Excel_Data = False

Dim Excel_File As String
Dim ExcelSave As Boolean

On Error GoTo err1
CommonDialog1.FileName = ""
CommonDialog1.Filter = "EXCEL (*.xls)|*.xls|"
CommonDialog1.FilterIndex = 1
CommonDialog1.ShowSave

If Err <> 32755 Then
Excel_File = CommonDialog1.FileName

If Dir(Excel_File) <> "" Then Kill Excel_File

Set sf1 = CreateObject("Excel.Application")

sf1.Workbooks.Add
Set sf2 = sf1.Workbooks(1)
Set sf3 = sf2.ActiveSheet

Dim x(1 To 3) As Integer, y(1 To 3) As Integer
x(1) = 1
x(2) = 2
x(3) = 9
y(1) = 12
y(2) = 5
y(3) = 19

sf3.Cells(1, 1).Value = x(1)
sf3.Cells(2, 1).Value = x(2)
sf3.Cells(3, 1).Value = x(3)
sf3.Cells(1, 2).Value = y(1)
sf3.Cells(2, 2).Value = y(2)
sf3.Cells(3, 2).Value = y(3)

sf2.Charts.Add
sf2.ActiveChart.Location 2, "Sheet1"
sf2.ActiveChart.ChartType = 72
sf2.ActiveChart.SeriesCollection(1).XValues = "=Sheet1!R1C1:R3C1"
sf2.ActiveChart.SeriesCollection(1).Values = "=Sheet1!R1C2:R3C2"

sf3.Shapes("图表 1").ScaleWidth 1.2, 0, 0
sf3.Shapes("图表 1").ScaleHeight 1.2, 0, 0

'picturebox控件显示excel中的图表
sf2.ActiveChart.ChartArea.Select
sf2.ActiveChart.ChartArea.Copy
form1.Picture1.Picture = Clipboard.GetData

sf3.SaveAs Excel_File

sf3.Application.Quit
Set sf3 = Nothing
Set sf2 = Nothing
Set sf1 = Nothing
End If

Save_Excel_Data = True

Exit Function
err1:
MsgBox Err.Number
End Function