第一次用这个控件〜发现他可以在VB6表单上载入EXCEL图形画面〜但是请问要怎么把资料放入去并产生图形？
能告知相关的网址或范例吗？（中文佳）

先前用ADODB抓出来的资料〜经过程式处理的阵列〜怎么让他在OLB载入的画面〜显示出正确的长条图？


本来想用MsChat〜但是后来发现画面蛮丑的〜才想说能不能用OLE来做〜

如果是这种的柱形图，我的纯VB代码实现的函数。这个很简单的。
我以前不是发一个折线图吗？那个是一组数据的。按多组数据的想办法处理就是了。

我用了柱形图，堆柱图，折线图三种。现在代码没在这电脑上，明天看看有空不。

我目前就是没去研究饼图，散点图之类，因为没用到过。

[此贴子已经被作者于2017-1-9 20:26编辑过]

OLE没有用过，但是MSChart也没有感觉特别糟糕，反而感到比较清晰，唯一缺点是底色不调整而已。

如果需要MSChart代码，联系我。

原来我以前回过
https://bbs.bccn.net/thread-442835-1-1.html

Private Sub cmdCommand1_Click()

    Const xlArea = 1
    Const xlBar = 2
    Const xlColumn = 3
    Const xlLine = 4
    Const xlPie = 5
    Const xlRadar = -4151
    Const xlXYScatter = -4169
    Const xlCombination = -4111
    Const xl3DArea = -4098
    Const xl3DBar = -4099
    Const xl3DColumn = -4100
    Const xl3DLine = -4101
    Const xl3DPie = -4102
    Const xl3DSurface = -4103
    Const xlDoughnut = -4120
   
    ' Excel orientation constants:
    Const xlRows = 1
    Const xlColumns = 2
   
    Dim objChart As Object           'Object reference to Excel
                                     'Chart
    Dim objXL As Object              'Object reference for Excel
       
    Dim objSheet As Object           'Object reference to Excel
                                     'Worksheet
    Dim iRow As Integer              'Index variable for the
                                     'current Row
    Dim iCol As Integer              'Index variable for the
                                     'current Row
    Dim cRows As Integer             'Number of rows
    Dim cCols As Integer             'Number of Columns
    Dim cwSource As String           'Named Range
    Static cwGallery(15) As Integer  'Array for Chart types
    Static iGallery As Integer       'Index for Chart type array
    Dim cwFormat As Integer          'Format of Chart type
    Dim cwPlotBy As Integer          'How data is taken from
                                     'Worksheet
    Dim cwCategoryLabels As Integer  'Rows/Cols with Catagory
                                     'labels
    Dim cwSeriesLabels As Integer    'Rows/Cols with Catagory
                                     'Labels
    Dim cwHasLegend As Integer       'Display Legend
    Dim cwTitle As String            'Chart Title
    Dim cwCategoryTitle As String    'Category Title
    Dim cwValueTitle As String       'Value Title
    Dim cwExtraTitle As String       'Extra Title for some Charts
                                     'disable this button
   
    ' Fill in array with possible Chart types:
    cwGallery(1) = xlArea
    cwGallery(2) = xlBar
    cwGallery(3) = xlColumn
    cwGallery(4) = xlLine
    cwGallery(5) = xlPie
    cwGallery(6) = xlRadar
    cwGallery(7) = xlXYScatter
    cwGallery(8) = xlCombination
    cwGallery(9) = xl3DArea
    cwGallery(10) = xl3DBar
    cwGallery(11) = xl3DColumn
    cwGallery(12) = xl3DLine
    cwGallery(13) = xl3DPie
    cwGallery(14) = xl3DSurface
    cwGallery(15) = xlDoughnut
   
    ' Embed a new Excel 5.0 Chart into the OLE control:
    OLE1.CreateEmbed "", "Excel.Chart.5"
    'BEGIN FIX FOR DIFFERING OBJECT MODELS BETWEEN VERSIONS 7 & 8
    ' Set object references to Chart, Worksheet, and Application
    'objects:
    'Excel 95's object model is different from Excel 97's
    If Left(OLE1.object.Application.Version, 1) = "7" Then
        Set objChart = OLE1.object ' Chart1 default chart
    Else  'assume all future excel object models are going to bethe same
        Set objChart = OLE1.object.ActiveChart 'ole1.object is in Excel 97 the workbook
    End If
   
    Set objSheet = objChart.Parent.Worksheets(1) ' Sheet1 default data
    Set objXL = objChart.Application
    'END FIX
   
    'Set the number of columns and rows used for data:
    cCols = 10
    cRows = 3
   
    ' Create Series Labels on Worksheet:
    For iRow = 1 To cRows
        objSheet.Cells(iRow + 1, 1).Value = "SL" & iRow
    Next
   
    ' Create Category Labels on Worksheet:
    For iCol = 1 To cCols
        objSheet.Cells(1, iCol + 1).Value = "CL" & iCol
    Next
    'exiting here leaves the default chart drawn with sample data
    ' Create random data on Worksheet:
    Randomize Timer
    For iRow = 1 To cRows
        For iCol = 1 To cCols
            objSheet.Cells(iRow + 1, iCol + 1).Value = Int(Rnd * 50) + 1
        Next iCol
    Next iRow
   
    ' Name the Range containing the previously added data:
    objSheet.Range(objSheet.Cells(1, 1), objSheet.Cells(cRows + 1, cCols + 1)).Name = "ChartDataRange"
    'objSheet.Range(objSheet.Cells(1, 1), objSheet.Cells(cRows + _
    1, cCols + 1)).Clear
    ' Set the ChartWizard parameters:
    cwSource = "ChartDataRange"       'Name of Named Range
    iGallery = 9 'iGallery Mod 15 + 1    'Iterate through 15 Chart
                                      'types
    cwFormat = 1                      'Use default format of Chart
                                      'Type
    cwPlotBy = xlRows                 'Rows = Series orientation
    cwCategoryLabels = 1              '1 Row contains Category
                                      'Labels
    cwSeriesLabels = 1                '1 Column contains Series
                                      'Labels
    cwHasLegend = 1                   'Display the Legend
    cwTitle = "Embedded Chart"        'Chart Title
    cwCategoryTitle = "Categories"    'Category Title
    cwValueTitle = "Values"           'Value Title
    cwExtraTitle = "Extras"           'Extra Title
   
    ' Use the ChartWizard method to fill in the Chart:
    objChart.ChartWizard cwSource, cwGallery(iGallery), cwFormat, cwPlotBy, cwCategoryLabels, cwSeriesLabels, cwHasLegend, cwTitle, cwCategoryTitle, cwValueTitle, cwExtraTitle
    ' Shut Down Excel and erase objects:
    Set objXL = Nothing
    Set objChart = Nothing
    Set objSheet = Nothing

End Sub

说明文件:
http://read.

2010年写的，不再解释

Option Explicit

Public Type 数据画图类型
    标题 As String
    项目() As String            'X轴
    指标() As String            '几根线的名称
    数据() As Double            '对应每根线的数据,是一个二维数组
End Type

Public Const 边距 = 500             '用来标注数字的高度和宽度
Public Const 图例宽 = 1800
Public Const 标题高 = 1000

'Public Const 图标样 = "△ ○ □ ☆ ⊿ ◇ ▽"
'Public Const 图标样 = "▲ ● ■ ★ ◢ ◆ ▼"
'Public Const 颜色表 = "4 1 6 3 9 2 13 10 14 11 12 5"
 
'Public 图标样 As String    
Public 颜色表 As String
  
Public 折线图标() As String         '使用配置文件

'--------显示用的边距---------
Public Const 左边距1 = 30
Public Const 右边距1 = 30
Public Const 上边距1 = 30
Public Const 下边距1 = 30

'--------打印用的边距--------
Public 左边距2 As Long
Public 右边距2 As Long
Public 上边距2 As Long
Public 下边距2 As Long


Public Enum 分析图类型分类
    折线分析图 = 1
    柱形分析图 = 2
    堆柱分析图 = 3
End Enum


'Public Sub 折线图(obj As PictureBox, DD As 数据画图类型, 有效高 As Long, 有效宽 As Long, 上边距 As Long, 左边距 As Long)
'Public Sub 折线图(obj As Object, DD As 数据画图类型, 有效高 As Long, 有效宽 As Long, 上边距 As Long, 左边距 As Long)
'Public Sub 折线图(obj As Object, DD() As 数据分析类型)
'DD,传进来需要绘图的数据


Public Sub 折线图(obj As Object, DD As 数据画图类型, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long)
On Error Resume Next


Dim 数据个数 As Long
数据个数 = UBound(DD.指标())

Dim COL() As Long
ReDim COL(数据个数)

Dim 样本数 As Long
样本数 = UBound(DD.项目) + 1

Dim Max As Double               ' 0起点
Max = 找MAX(DD)
Max = Int(Max) + 1              'max= 向上取一整

Dim Y坐标间隔(10) As Long
Dim X坐标间隔() As Long
ReDim X坐标间隔(样本数)


Dim 有效高  As Long
Dim 高间隔 As Long
有效高 = obj.ScaleHeight - 上边距 - 下边距 - 标题高 - 边距
高间隔 = (有效高) / 10

Dim 有效宽  As Long
Dim 宽间隔 As Long
有效宽 = obj.ScaleWidth - 左边距 - 右边距 - 边距      '边距是用来标Y坐标的
宽间隔 = (有效宽 - 图例宽 - 150) / (样本数 + 1)

Dim i As Long, j As Long
Dim strtmp As String, k As Long

For i = 0 To 10
    Y坐标间隔(i) = i * 高间隔
Next i

For i = 0 To 样本数
    X坐标间隔(i) = i * 宽间隔
Next i
    
'读颜色
Call 颜色(COL())
'画坐标网络
Call 画坐标系(obj, 上边距, 下边距, 左边距, 右边距, Max, DD, COL())
'画图例
Call 画图例折(obj, 上边距, 下边距, 左边距, 右边距, Max, DD, COL())
        
        
    '绘图
    Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long, k5 As Long, k6 As Long
    
        'k1 = 左边距 + 宽间隔 + 边距
        'k2 = 上边距 + 标题高 + 有效高
        
        obj.FontSize = 8
        obj.FontTransparent = False
        k5 = obj.TextHeight(" ") / 2
        k6 = obj.TextWidth(" ") / 2
        
    obj.DrawWidth = 2
    obj.FontSize = 8
    For i = 0 To 数据个数
    
            obj.ForeColor = COL(i)
            k1 = 左边距 + 宽间隔 + 边距
            k2 = 上边距 + 标题高 + 有效高 - DD.数据(0, i) / Max * 有效高
            obj.CurrentX = k1 - k5
            obj.CurrentY = k2 - k6
            obj.Print 折线图标(i)
            'obj.Circle (k1, k3), 30, COL(i)                '画圆,需取消
            
        
        For j = 1 To 样本数 - 1
            
            k3 = 左边距 + 宽间隔 * (j + 1) + 边距
            k4 = 上边距 + 标题高 + 有效高 - DD.数据(j, i) / Max * 有效高
            
            obj.CurrentX = k3 - k5
            obj.CurrentY = k4 - k6
            obj.Print 折线图标(i)
            
            obj.Line (k1, k2)-(k3, k4), COL(i)
            k1 = k3
            k2 = k4
            
            'k = 上边距 + 标题高 + 有效高 - DD.数据(j, i) / Max * 有效高
            'obj.Line -((左边距 + 宽间隔 * (j + 1)) + 边距, k), COL(i)
            'obj.Circle ((左边距 + 宽间隔 * (j + 1)) + 边距, k), 30, COL(i)
        Next j
    Next i
    
    obj.FontTransparent = True
'Stop

End Sub

Public Function 找MAX(DD As 数据画图类型) As Double
On Error Resume Next

Dim Max As Double               ' 0起点
Dim i As Long, j As Long
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())

Dim 样本数 As Long
样本数 = UBound(DD.项目)

For i = 0 To 样本数
    For j = 0 To 数据个数
        If Max < DD.数据(i, j) Then
            Max = DD.数据(i, j)
        End If
    Next j
Next i

找MAX = Max

End Function

Public Sub 堆柱图(obj As Object, DD As 数据画图类型, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long)
On Error Resume Next

Dim 数据个数 As Long
数据个数 = UBound(DD.指标())

Dim COL() As Long
ReDim COL(数据个数)

Dim 样本数 As Long
样本数 = UBound(DD.项目) + 1

Dim Max As Double               ' 0起点
Max = 找和MAX(DD)
Max = Int(Max) + 1              'max= 向上取一整

Dim Y坐标间隔(10) As Long
Dim X坐标间隔() As Long
ReDim X坐标间隔(样本数)


Dim 有效高  As Long
Dim 高间隔 As Long
有效高 = obj.ScaleHeight - 上边距 - 下边距 - 标题高 - 边距
高间隔 = (有效高) / 10

Dim 有效宽  As Long
Dim 宽间隔 As Long
有效宽 = obj.ScaleWidth - 左边距 - 右边距 - 边距      '边距是用来标Y坐标的
宽间隔 = (有效宽 - 图例宽 - 150) / (样本数 + 1)

Dim i As Long, j As Long
Dim strtmp As String, k As Long

For i = 0 To 10
    Y坐标间隔(i) = i * 高间隔
Next i

For i = 0 To 样本数
    X坐标间隔(i) = i * 宽间隔
Next i
    
'读颜色
Call 颜色(COL())
'画坐标网络
Call 画坐标系(obj, 上边距, 下边距, 左边距, 右边距, Max, DD, COL())
'画图例
Call 画图例(obj, 上边距, 下边距, 左边距, 右边距, Max, DD, COL())

    
    '绘图
    
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long
    obj.DrawWidth = 1

    For i = 0 To 样本数 - 1
        k = 0
        k1 = 上边距 + 标题高 + 有效高
        k2 = 左边距 + 宽间隔 * i + 宽间隔 * 0.75 + 边距
        k3 = k2 + 宽间隔 * 0.5
        k = k1
        For j = 0 To 数据个数
            
            k4 = DD.数据(i, j) / Max * 有效高
            k = k - k4
            
            obj.Line (k2, k)-(k3, k1), COL(j), BF
            k1 = k
        Next j
    Next i

End Sub

Public Sub 柱形图(obj As Object, DD As 数据画图类型, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long)
On Error Resume Next

Dim 数据个数 As Long
数据个数 = UBound(DD.指标())

Dim COL() As Long
ReDim COL(数据个数)

Dim 样本数 As Long
样本数 = UBound(DD.项目) + 1

Dim Max As Double               ' 0起点
Max = 找MAX(DD)
Max = Int(Max) + 1              'max= 向上取一整

Dim Y坐标间隔(10) As Long
Dim X坐标间隔() As Long
ReDim X坐标间隔(样本数)


Dim 有效高  As Long
Dim 高间隔 As Long
有效高 = obj.ScaleHeight - 上边距 - 下边距 - 标题高 - 边距
高间隔 = (有效高) / 10

Dim 有效宽  As Long
Dim 宽间隔 As Long
有效宽 = obj.ScaleWidth - 左边距 - 右边距 - 边距      '边距是用来标Y坐标的
宽间隔 = (有效宽 - 图例宽 - 150) / (样本数 + 1)

Dim i As Long, j As Long
Dim strtmp As String, k As Long

For i = 0 To 10
    Y坐标间隔(i) = i * 高间隔
Next i

For i = 0 To 样本数
    X坐标间隔(i) = i * 宽间隔
Next i
    
'读颜色
Call 颜色(COL())
'画坐标网络
Call 画坐标系(obj, 上边距, 下边距, 左边距, 右边距, Max, DD, COL())
'画图例
Call 画图例(obj, 上边距, 下边距, 左边距, 右边距, Max, DD, COL())

    
    '绘图
    
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long
Dim k5 As Long, k6 As Long

    obj.DrawWidth = 1
    k5 = (宽间隔 * 0.8) / (数据个数 + 1)
    
    For i = 0 To 样本数 - 1
        

        k1 = 上边距 + 标题高 + 有效高
        
        'k2 = 左边距 + 宽间隔 * i + 宽间隔 * 0.75 + 边距
        k2 = 左边距 + 边距 + 宽间隔 * i + 宽间隔 * 0.6

        
        For j = 0 To 数据个数
            
            k4 = DD.数据(i, j) / Max * 有效高
            k3 = k2 + k5 * j
            k6 = k2 + k5 * j + k5
            obj.Line (k3, k1 - k4)-(k6, k1), COL(j), BF
        Next j
    Next i

End Sub

Public Function 找和MAX(DD As 数据画图类型) As Double
Dim Max As Double               ' 0起点
Dim i As Long, j As Long
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())

Dim 样本数 As Long
样本数 = UBound(DD.项目)

Dim m As Double

For i = 0 To 样本数
    m = 0
    For j = 0 To 数据个数
        m = m + DD.数据(i, j)
    Next j
    If Max < m Then
        Max = m
    End If
Next i

找和MAX = Max

End Function

Public Sub 颜色(cs() As Long)

On Error Resume Next

Dim i As Long, j As Long
Dim k As Long

Dim fj() As String

If InStr(1, 颜色表, ",") > 0 Then
    fj = Split(颜色表, ",")
Else
    fj = Split(颜色表, " ")
End If

For i = 0 To UBound(cs)
    k = Val(fj(i))
    If k < 14 Then
        cs(i) = QBColor(k)
    Else
        cs(i) = k
    End If
    If i >= UBound(fj) Then
        Exit For
    End If
Next i

End Sub

'Public Sub 画坐标系(obj As Object, 上边距 As Long, 左边距 As Long, 宽间隔 As Long, 高间隔 As Long, 有效宽 As Long, 有效高 As Long, Max As Double, Y坐标间隔() As Long, DD As 数据画图类型, COL() As Long)

Public Sub 画坐标系(obj As Object, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long, Max As Double, DD As 数据画图类型, COL() As Long)

On Error Resume Next

Dim i As Long
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long, k5 As Long
Dim strtmp As String
Dim s1() As String
Dim linecolor As Long

'-----------数据个数----------------
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())

Dim 样本数 As Long
样本数 = UBound(DD.项目) + 1

Dim Y坐标间隔(10) As Long
Dim X坐标间隔() As Long

'---------计算坐标数据-----------
ReDim X坐标间隔(样本数)

Dim 有效高  As Long
Dim 高间隔 As Long
有效高 = obj.ScaleHeight - 上边距 - 下边距 - 标题高 - 边距
高间隔 = (有效高) / 10

Dim 有效宽  As Long
Dim 宽间隔 As Long
有效宽 = obj.ScaleWidth - 左边距 - 右边距 - 边距      '边距是用来标Y坐标的
宽间隔 = (有效宽 - 图例宽 - 150) / (样本数 + 1)

For i = 0 To 10
    Y坐标间隔(i) = i * 高间隔
Next i

For i = 0 To 样本数
    X坐标间隔(i) = i * 宽间隔
Next i



'显示标题
    obj.ForeColor = 0
    obj.FontSize = 20
    obj.FontBold = True
    obj.CurrentX = (有效宽 - obj.TextWidth(DD.标题)) / 2 + 左边距
    obj.CurrentY = 上边距 + (标题高 - obj.TextHeight(DD.标题)) / 2
    obj.Print DD.标题
    
    obj.FontBold = False


linecolor = RGB(128, 128, 128)

'画坐标系
obj.FontSize = 9
obj.DrawWidth = 1
        
        k5 = 上边距 + 标题高
        k3 = (左边距 + 宽间隔 * 样本数 + 宽间隔) + 边距
    For i = 0 To 10                     '横线
        'obj.ForeColor = RGB(128, 128, 128)
        k2 = (Y坐标间隔(i) + k5)
       
        obj.Line (左边距 + 边距, k2)-(k3, k2), linecolor
        'obj.ForeColor = 0               '显示坐标系Y
        strtmp = Format(Max - Max / 10 * i, "0.0")
        obj.CurrentX = 左边距 + 边距 - obj.TextWidth(strtmp) - 50
        obj.CurrentY = Y坐标间隔(i) + k5 - obj.TextHeight(strtmp) / 2
        obj.Print strtmp
    Next i

        k2 = 有效高 + k5
    For i = 0 To 样本数 + 1             '竖线
        'obj.ForeColor = RGB(128, 128, 128)
        k1 = 左边距 + i * 宽间隔 + 边距
        obj.Line (k1, k5)-(k1, k2), linecolor
        
        If i > 0 And i < 样本数 + 1 Then               '显示坐标系X
            'obj.ForeColor = 0
            strtmp = DD.项目(i - 1)
            s1 = Split(strtmp, " ")
            k1 = 宽间隔 * i + 左边距 + 边距
            k4 = k2 + obj.TextHeight(strtmp) / 2
            obj.CurrentY = obj.CurrentY + 30
            For k3 = 0 To UBound(s1)
                obj.CurrentX = k1 - obj.TextWidth(s1(k3)) / 2
                obj.CurrentY = obj.CurrentY + obj.TextHeight(strtmp) * 0.2
                obj.Print s1(k3)
            Next k3
        End If
    Next i
End Sub

'Public Sub 画图例(obj As Object, 上边距 As Long, 左边距 As Long, 宽间隔 As Long, 高间隔 As Long, 有效宽 As Long, 有效高 As Long, Max As Double, Y坐标间隔() As Long, DD As 数据画图类型, COL() As Long)

Public Sub 画图例(obj As Object, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long, Max As Double, DD As 数据画图类型, COL() As Long)

On Error Resume Next

Dim i As Long, j As Long
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long, k5 As Long
Dim strtmp As String
Dim s1() As String

'-----------数据个数----------------
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())

Dim 样本数 As Long
样本数 = UBound(DD.项目) + 1

Dim Y坐标间隔(10) As Long
Dim X坐标间隔() As Long

'---------计算坐标数据-----------
ReDim X坐标间隔(样本数)

Dim 有效高  As Long
Dim 高间隔 As Long
有效高 = obj.ScaleHeight - 上边距 - 下边距 - 标题高 - 边距
高间隔 = (有效高) / 10

Dim 有效宽  As Long
Dim 宽间隔 As Long
有效宽 = obj.ScaleWidth - 左边距 - 右边距 - 边距      '边距是用来标Y坐标的
宽间隔 = (有效宽 - 图例宽 - 150) / (样本数 + 1)

For i = 0 To 10
    Y坐标间隔(i) = i * 高间隔
Next i

For i = 0 To 样本数
    X坐标间隔(i) = i * 宽间隔
Next i


        k5 = 上边距 + 标题高
'图例
    '图例,双线框
    obj.ForeColor = 0
    k3 = 左边距 + 有效宽 + 边距      '右角
    k2 = k3 - 图例宽                 '左角
    
    obj.Line (k2, k5)-(k3, k5 + 有效高), , B
    obj.Line (k2 + 30, k5 + 30)-(k3 - 30, k5 + 有效高 - 30), , B
    
    strtmp = "图 例"
    obj.FontSize = 12
    obj.CurrentX = k3 - (图例宽 + obj.TextWidth(strtmp)) / 2    'K3 是右角
    obj.CurrentY = k5 + 高间隔
    obj.Print strtmp
    
    obj.FontSize = 9
    obj.DrawWidth = 2
    For i = 0 To 数据个数
        
        If 数据个数 = 0 Then
            j = k5 + 高间隔 * 4.5 + obj.TextHeight(" ") / 2
        Else
            j = k5 + 高间隔 * 3 + i * (高间隔 * 5 / 数据个数) + obj.TextHeight(" ") / 2
        End If
            
        obj.Line ((k3 - 图例宽 / 2 + 150), j - 50)-(k3 - 150, j + 50), COL(i), BF 'k3 为右角
        
        If 数据个数 = 0 Then
            j = k5 + 高间隔 * 4.5
        Else
            j = k5 + 高间隔 * 3 + i * (高间隔 * 5 / 数据个数)
        End If
        obj.ForeColor = 0
        obj.CurrentX = k2 + 150        'k2 为左角
        obj.CurrentY = j
        obj.Print DD.指标(i)
    Next i
    
End Sub

Public Sub 画图例折(obj As Object, 上边距 As Long, 下边距 As Long, 左边距 As Long, 右边距 As Long, Max As Double, DD As 数据画图类型, COL() As Long)

On Error Resume Next

Dim i As Long, j As Long
Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long, k5 As Long
Dim strtmp As String
Dim s1() As String

'-----------数据个数----------------
Dim 数据个数 As Long
数据个数 = UBound(DD.指标())

Dim 样本数 As Long
样本数 = UBound(DD.项目) + 1

Dim Y坐标间隔(10) As Long
Dim X坐标间隔() As Long

'---------计算坐标数据-----------
ReDim X坐标间隔(样本数)

Dim 有效高  As Long
Dim 高间隔 As Long
有效高 = obj.ScaleHeight - 上边距 - 下边距 - 标题高 - 边距
高间隔 = (有效高) / 10

Dim 有效宽  As Long
Dim 宽间隔 As Long
有效宽 = obj.ScaleWidth - 左边距 - 右边距 - 边距      '边距是用来标Y坐标的
宽间隔 = (有效宽 - 图例宽 - 150) / (样本数 + 1)

For i = 0 To 10
    Y坐标间隔(i) = i * 高间隔
Next i

For i = 0 To 样本数
    X坐标间隔(i) = i * 宽间隔
Next i


        k5 = 上边距 + 标题高
'图例
    '图例,双线框
    obj.ForeColor = 0
    k3 = 左边距 + 有效宽 + 边距      '右角
    k2 = k3 - 图例宽                 '左角
    
    obj.Line (k2, k5)-(k3, k5 + 有效高), , B
    obj.Line (k2 + 30, k5 + 30)-(k3 - 30, k5 + 有效高 - 30), , B
    
    strtmp = "图 例"
    obj.FontSize = 12
    obj.CurrentX = k3 - (图例宽 + obj.TextWidth(strtmp)) / 2    'K3 是右角
    obj.CurrentY = k5 + 高间隔
    obj.Print strtmp
    
    obj.FontSize = 9
    obj.DrawWidth = 2
    For i = 0 To 数据个数
        
        If 数据个数 = 0 Then
            j = k5 + 高间隔 * 4.5 + obj.TextHeight(" ") / 2
        Else
            j = k5 + 高间隔 * 3 + i * (高间隔 * 5 / 数据个数) + obj.TextHeight(" ") / 2
        End If
            
        obj.Line ((k3 - 图例宽 / 2 + 150), j)-(k3 - 150, j), COL(i), BF   'k3 为右角
        obj.ForeColor = COL(i)
        obj.CurrentX = (k3 - 图例宽 / 2 + k3) / 2 - obj.TextWidth(" ") / 2
        obj.CurrentY = j - obj.TextHeight(" ") / 2
        obj.Print 折线图标(i)

        
        If 数据个数 = 0 Then
            j = k5 + 高间隔 * 4.5
        Else
            j = k5 + 高间隔 * 3 + i * (高间隔 * 5 / 数据个数)
        End If
        obj.ForeColor = 0
        obj.CurrentX = k2 + 150        'k2 为左角
        obj.CurrentY = j
        obj.Print DD.指标(i)
    Next i

 End Sub

收到的鲜花

• wube 于 2017-01-12 18:06 送鲜花  10朵   附言：好文章

https://bbs.bccn.net/thread-172510-1-1.html
无意中找到这篇...里面有个示例代码可能有用
在另一个CASE需要做出下图，但问题是使用该程式的电脑没EXCEL


刚好这个自定控件X轴密集一点后应该就会变成上面的效果

結果...