=====Excel图表.foxdb=====
项目事件
AfterOpenProject
Forms(\图表设置\
计划管理
表事件
窗口表事件
窗口与控件事件
图表设置_AfterLoad
Dim x,y As String Dim i As Integer
For Each c As Col In Currenttable.Cols If c.Visible Then i = i + 1
If c.Datacol.IsNumeric Then
y = y & \【\】\ Else
x = x & \【\】\ End If End If Next
e.Form.Controls(\e.Form.Controls(\
图表设置_Button1_Click
exStr = \图表区\
Forms(\图表外观\
图表设置_Button2_Click
exStr = \绘图区\
Forms(\图表外观\
图表设置_Button3_Click
exStr = \图例\
Forms(\图表外观\
图表设置_Button4_Click
exStr = \标题\
Forms(\图表外观\
图表设置_Button5_Click
'对数据列验证
1
Dim y As String = e.Form.Controls(\Dim x As String = e.Form.Controls(\If y = \
MessageBox.Show(\数据系列中的数值轴(Y)必须设置! \信息提示\ Return Else
If e.Form.Controls(\
MessageBox.Show(\数值轴(Y)不能全部设置为次坐标轴! \信息提示\ Return End If End If
Dim ksl,jsl As Integer 'x轴的起始列与结束列 If x <> \
Dim xs As String() = x.Split(\
If xs.Length > 1 '如果x轴有多列 Dim xsn(xs.Length-1) As Integer
For n As Integer = 0 To xs.Length - 1
xsn(n) = xs(n).SubString(1,xs(n).LastIndexOf(\】\ Next
Array.Sort(xsn) '得到各列的序号,并排序 For n As Integer = 1 To xsn.Length - 1 If xsn(n) - xsn(n-1) > 1
MessageBox.Show(\如果X轴的分类列有多个, 那么它必须是连续的! \信息提示\ Return End If Next
ksl = xsn(0)
jsl = xsn(xsn.Length-1) Else
ksl = x.SubString(1,x.LastIndexOf(\】\ jsl = ksl End If End If
'定义Excel
Dim f As String = ProjectPath & \数据.xls\Dim t As Table = CurrentTable Dim flg As New SaveExcelFlags flg.CellStyle = True
t.SaveExcel(f,t.Name,flg) '导出数据到指定文件 Dim App As New MSExcel.Application App.DisplayAlerts = False
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(f) Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim i As Integer = e.Form.Controls(\指定大小 Dim j As Integer = e.Form.Controls(\
Dim rg As MSExcel.Range = Ws.Cells(t.HeaderRows + t.Rows.Count,1)
Dim Co As MSExcel.ChartObject = Ws.ChartObjects.Add(rg.Left,rg.Top,i,j) '在最末行的第一个单元格处生成图表
Ws.DrawingObjects(1).Shadow = e.Form.Controls(\阴影 Ws.DrawingObjects(1).RoundedCorners = e.Form.Controls(\圆角 Dim Cht As MSExcel.Chart = Co.Chart
Functions.Execute(\图表区\设置图表区外观,此行不能放到后面,否则将
2
替代其它对象的设置
'图表类型并指定y轴和绘图方式 Cht.ChartType =
Functions.Execute(\).Value)
Dim cs As String() = y.Split(\Dim lh As Integer Dim ar As String
Dim first As Integer = CurrentTable.HeaderRows + 1 '数据记录的起始行 Dim last As Integer = CurrentTable.HeaderRows + CurrentTable.Rows.Count '数据记录的结束行 For Each c As String In cs
lh = c.SubString(1,c.LastIndexOf(\】\
ar = ar & \Functions.Execute(\Next
ar = ar.Trim(\rg = Ws.Range(ar)
If e.Form.Controls(\饼图\ Dim ars As String() = ar.Split(\ If ars.Length > 1 Then rg = Ws.Range(ars(0)) End If End If
If e.Form.Controls(\
Cht.SetSourceData(rg,MSExcel.XlRowCol.xlColumns) '数据产生自列 Else
Cht.SetSourceData(rg,MSExcel.XlRowCol.xlRows) '数据产生于行 End If
Functions.Execute(\绘图区\绘图区的外观设置 '指定x轴的分类列区域 Dim xbz As String If x <> \
xbz = \ If e.Form.Controls(\合并单元格 For m As Integer = jsl To ksl Step -1 Dim hh As Integer = first
For n As Integer = first+1 To last+1
If Ws.Cells(n,m).Value <> Ws.Cells(hh,m).Value Then rg = Ws.Range(Ws.Cells(hh,m),Ws.Cells(n-1,m)) If m = ksl Then rg.Merge
rg.VerticalAlignment = MSExcel.Constants.xlCenter hh = n
Elseif Ws.Cells(n,m-1).Value = Ws.Cells(hh,m-1).Value Then rg.Merge
rg.VerticalAlignment = MSExcel.Constants.xlCenter hh = n End If End If Next Next End If End If
'设置每个数据系列
Dim czb As String = e.Form.Controls(\
3
Dim czbs As New List(Of String) '次坐标轴集合 If czb > \
czbs.AddRange(czb.Split(\End If
Dim s As MSExcel.Series
Dim ys As Integer = 15 '颜色序号从15开始 For n As Integer = 1 To cs.Length
If e.Form.Controls(\饼图\ If n > 1 Then Exit For End If End If
s = Cht.SeriesCollection(n) If x <> \
s.XValues = xbz '指定对应的x轴 End If
s.Name = cs(n-1).SubString(cs(n-1).LastIndexOf(\】\系列名称 If czbs.Contains(cs(n-1)) '如果在次坐标集合中找到对应的内容 s.AxisGroup = 2 End If
Functions.Execute(\数据系列_\ ys = ys+3 Next
'设置坐标轴
If e.Form.Controls(\饼图\ Dim y1min,y1max,y2min,y2max As Integer '设置刻度 If czb > \如果有主轴和次轴就要分别设置 ar = \
Dim br As String
Dim lst1() As String = e.Form.Controls(\ Dim lst2() As String = e.Form.Controls(\ For Each c As String In lst1
lh = c.SubString(1,c.LastIndexOf(\】\
ar = ar & \Functions.Execute(\ Next
For Each c As String In lst2
lh = c.SubString(1,c.LastIndexOf(\】\
br = br & \Functions.Execute(\ Next
rg = Ws.Range(ar.Trim(\
y1min = App.WorksheetFunction.Min(rg) y1max = App.WorksheetFunction.Max(rg) With Cht.Axes(MSExcel.XlAxisType.xlValue) .MinimumScale = y1min .MaximumScale = y1max End With
rg = Ws.Range(br.Trim(\
y2min = App.WorksheetFunction.Min(rg) y2max = App.WorksheetFunction.Max(rg)
With Cht.Axes(MSExcel.XlAxisType.xlValue,2) .MinimumScale = y2min .MaximumScale = y2max End With
4
Else '否则只要设置主轴刻度
y1min = App.WorksheetFunction.Min(Ws.Range(ar)) y1max = App.WorksheetFunction.Max(Ws.Range(ar)) With Cht.Axes(MSExcel.XlAxisType.xlValue) .MinimumScale = y1min .MaximumScale = y1max End With End If
If e.Form.Controls(\ With Cht.Axes(MSExcel.XlAxisType.xlCategory) '设置X轴标题网格 .HasTitle = True
.AxisTitle.Text = e.Form.Controls(\
.HasMajorGridlines = e.Form.Controls(\ .HasMinorGridlines = e.Form.Controls(\ End With End If
If e.Form.Controls(\ With Cht.Axes(MSExcel.XlAxisType.xlValue,1) '设置Y主轴标题网格 .HasTitle = True
.AxisTitle.Text = e.Form.Controls(\
.HasMajorGridlines = e.Form.Controls(\ .HasMinorGridlines = e.Form.Controls(\ End With End If
If e.Form.Controls(\e.Form.Controls(\
With Cht.Axes(MSExcel.XlAxisType.xlValue,2) '设置Y次轴标题网格 .HasTitle = True
.AxisTitle.Text = e.Form.Controls(\ End With End If End If '图例
Dim sfxs As Boolean = e.Form.Controls(\Cht.HasLegend = sfxs If sfxs Then
Functions.Execute(\图例\End If '标题
sfxs = e.Form.Controls(\Cht.HasTitle = sfxs If sfxs Then
Functions.Execute(\标题\End If '显示表格
sfxs = e.Form.Controls(\Cht.Hasdatatable = sfxs App.Visible = True
图表设置_Button6_Click
Dim cb As WinForm.CheckedComboBox = e.Form.Controls(\Dim tblx As String = e.Form.Controls(\
If tblx.Contains(\三维\饼图\圆柱\圆锥\棱锥\
5