表格界面，填写股票代码后点击“下载报表”。
即下载财报到f盘，（此处需手动先打开下载好的文件）选择好要分析的科目，然后贴数据到主页面并生成折线图，可手动挪动图表行改分析的科目，嘻嘻。
以下为两个按钮的代码。
Sub dl()
Dim code As String
Dim kemu As String
code = Range("j3").Value
Dim H, S
Set H = CreateObject("Microsoft.XMLHTTP")
H.Open "GET", "http://money.finance.sina.com.cn/corp/go.php/vDOWN_BalanceSheet/displaytype/4/stockid/" & code & "/ctrl/all.phtml", False '网络中的文件URL
H.send
Set S = CreateObject("ADODB.Stream")
S.Type = 1
S.Open
S.write H.Responsebody
S.savetofile "f:\" & code & ".xls", 2 '本地保存文件名
S.Close
End SubSub Button3_Click()
'
' Button3_Click Macro
'
Dim code As String
Dim kemu As Integer
Dim id As String
code = Range("j3").Value
kemu = Range("g4").Value
Workbooks("F:\" & code & ".xls").Sheets(code).Range("A1:CQ70").Copy Range("A15")
id = kemu + 14Dim oChart As ChartDim oWK As WorksheetDim oSeries As SeriesDim oChartObject As ChartObjectSet oWK = Excel.Worksheets(1)'先创建一个空白的图形壳Set oChartObject = oWK.ChartObjects.Add(100, 0, 500, 300)Set oChart = oChartObject.Chart'对空白的图形进行设置With oChart'默认创建的是两个系列的散点图.ChartWizard Source:=oWK.Range("b" & id & ":cq" & id), gallery:=xlXYScatterLines, PlotBy:=xlColumns, HasLegend:=True, _Title:=id, CategoryTitle:="X", ValueTitle:="Y"For Each oSeries In .SeriesCollectionoSeries.DeleteNextSet oSeries = .SeriesCollection.NewSeriesWith oSeries.Name = id.Values = oWK.Range("b" & id & ":cq" & id).XValues = oWK.Range("b15:cq15")End WithEnd With
End Sub
Sub test()
Dim a As Integer
Dim b As String
a = 1
b = a + 1
Debug.Print (b)
End SubSub char()'创建内嵌的图表Dim oChart As ChartDim oWK As WorksheetDim oSeries As SeriesDim oChartObject As ChartObjectSet oWK = Excel.Worksheets(1)'先创建一个空白的图形壳Set oChartObject = oWK.ChartObjects.Add(100, 0, 500, 300)Set oChart = oChartObject.Chart'对空白的图形进行设置With oChart'默认创建的是两个系列的散点图.ChartWizard Source:=oWK.Range("a1:d2"), gallery:=xlXYScatterLines, PlotBy:=xlColumns, HasLegend:=True, _Title:="这是一个散点图", CategoryTitle:="X", ValueTitle:="Y"For Each oSeries In .SeriesCollectionoSeries.DeleteNextSet oSeries = .SeriesCollection.NewSeriesWith oSeries.Name = "X-Y".Values = oWK.Range("a2:d2").XValues = oWK.Range("a1:d1")End WithEnd With
End Sub附上文件链接：链接: https://pan.baidu.com/s/1qKIAHnZdl2S5wyOtUTuHlA 提取码: 9a4y
