SetXAxisHeadings函数

发表于:2007-06-21来源:作者:点击数: 标签:
Sub SetXAxisHeadings(ByVal oRs As ADODB.Recordset, ByVal strValueCol As String) Dim iCount As Integer Dim iRow, iCol As Integer Dim nMaxRows As Integer Dim oFill As Excel.ChartFillFormat 注释:--- 检查参数是否合法 If (IsNull(oRs) Or IsNull

     

Sub SetXAxisHeadings(ByVal oRs As ADODB.Recordset, ByVal strValueCol As String)
  Dim iCount As Integer
  Dim iRow, iCol As Integer
  Dim nMaxRows As Integer

  Dim oFill As Excel.ChartFillFormat
  
  注释:--- 检查参数是否合法
  If (IsNull(oRs) Or IsNull(strValueCol) _
         Or oExcelChart.SeriesCollection.Count <  1) Then
    Err.Raise Number:=1001 + vbObjectError, _
         Description:="Invalid recordset or column name"
    Exit Sub
  End If
  
On Error GoTo hError
  注释:--- 单个数据系列中最大数据个数
  nMaxRows = 25
  注释:--- 设置初始值和位置
  oRs.MoveFirst
  iRow = 0: iCol = 1
  注释:--- 循环,将记录集中的数据写入工作表第一列
  While (Not oRs.EOF And iRow <  nMaxRows)
    iRow = iRow + 1
    注释:--- 设置单元格的值
    oExcelSheet.Cells(iRow, iCol) = CStr(oRs(strValueCol).Value)
    注释:--- 下一行
    oRs.MoveNext
  Wend
  
  注释:--- 检查是否确实写入了数据
  If (iRow  > 0) Then
    注释:--- 将这些数据设置为X-轴标签
    oExcelChart.SeriesCollection(1).XValues = _
      oExcelSheet.Range(oExcelSheet.Cells(1, iCol), _
      oExcelSheet.Cells(iRow, iCol))
  End If
  
  Exit Sub
  
hError:
  App.LogEvent Err.Description, vbLogEventTypeError
  Err.Raise Err.Number, Err.Source, Err.Description

End Sub




   该方法的处理步骤与AddDataSeries()方法相似。标题也是作为记录集的一个列传入,其中的值被加入到工作表中保留的第一个列,然后程序使用Series对象的XValues对象和工作表对象的Range()方法将这些数据加入图表。Range()方法返回的是一个区域,该区域被赋给了Chart对象的XValues对象。

原文转自:http://www.ltesting.net