📄 sheet1.vb
字号:
'Imports System.Data.OleDb
Public Class Sheet1
Public ReportDetail As New ArrayList
'Public strChange(1, 200) As String
Public ReportDetailUnit As New ArrayList
Public ReportTitle As New ArrayList
Private NULL As System.DBNull
Private PicCurve As New PictureBox
Private myUserControl As New UserControl1
Private Sub Sheet1_Startup(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Startup
Try
BindNamedRange()
'绑定UserControl控件
Globals.ThisWorkbook.ActionsPane.Controls.Add(myUserControl)
'PicCurve.Load("C:\Program Files\Tester\Curve.bmp")
'PicCurve.SizeMode = PictureBoxSizeMode.StretchImage
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
'读表里的内容,并显示
Public Function TableRead(ByVal strFormat As String) As Boolean
Dim i, j, c
Dim rowTempt As DataRow
Dim temp As Integer
temp = ReportDetail(0).Cells.Row + 2
i = 0
Dim count As Integer
count = Globals.ThisWorkbook.tbSheet.Rows.Count - 1
Dim rng As Excel.Range = Me.Application.Range("A" & temp.ToString)
Try
TableUntil()
rng.Value2 = 1
rng.AutoFill(Me.Application.Range("A" & temp.ToString & ":A" & (temp + count).ToString), Excel.XlAutoFillType.xlFillSeries)
For Each rowTempt In Globals.ThisWorkbook.tbSheet.Rows
For j = 1 To ReportDetail.Count - 1
If ReportDetail(j).value2 <> "" Then
For c = 0 To Globals.ThisWorkbook.tbSheet.Columns.Count - 1
If ReportDetail(j).value2 = Globals.ThisWorkbook.strChange(0, c) Then
If Not Convert.IsDBNull(rowTempt(Globals.ThisWorkbook.strChange(1, c))) Then
If rowTempt(ReportDetail(j).value2).GetType().ToString = "System.String" Then
Me.Range(Chr(Asc("A") + j) & temp + i).Value2() = rowTempt(Globals.ThisWorkbook.strChange(1, c))
Else
If rowTempt(ReportDetail(j).value2).GetType().ToString = "System.DateTime" Then
Me.Range(Chr(Asc("A") + j) & temp + i).Value2() = Format(rowTempt(Globals.ThisWorkbook.strChange(1, c)), " yyyy - MM - dd tt hh:mm")
Else
Me.Range(Chr(Asc("A") + j) & temp + i).Value2() = Format(rowTempt(Globals.ThisWorkbook.strChange(1, c)), strFormat)
End If
End If
Exit For
End If
End If
Next
End If
Next
i = i + 1
Next
Catch ex As ArgumentException
MessageBox.Show("ArgumentException" & ex.Message)
Catch ex As Exception
MessageBox.Show("Exception" & ex.Message)
Return False
End Try
Return True
End Function
'详细部分的单位绑定
Private Sub TableUntil()
Dim i As Integer
Dim j As Integer
Dim temp As Integer
Dim rowDB As DataRow
Try
For i = 1 To ReportDetail.Count - 1
If ReportDetail(i).value2 <> "" Then
For j = 0 To Globals.ThisWorkbook.tbSheet.Columns.Count - 1
'MessageBox.Show(Globals.ThisWorkbook.strChange(0, j))
If ReportDetail(i).value2.ToString = Globals.ThisWorkbook.strChange(0, j) Then
temp = Globals.ThisWorkbook.DBChange.GetUnitID(Globals.ThisWorkbook.strChange(1, j))
rowDB = Globals.ThisWorkbook.tbUnit.Rows.Find(temp)
If rowDB Is Nothing Then
Else
ReportDetailUnit(i).value2 = rowDB("Label")
End If
Exit For
End If
Next
End If
Next
Catch ex As ArgumentException
MessageBox.Show("找不到 数据库字段 " & ReportDetail(i).ToString & "!")
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
'函数计算,strFunction 输入Excel里标准的函数名称,strName需要显示的函数名字,在A列显示,listRows在第几行开始显示。
Public Sub sheetResult(ByVal strName As String, ByVal strFunction As String, ByVal listRows As Integer)
Dim i, j
'Dim resultNRange As New ArrayList
For i = 0 To ReportDetail.Count - 1
Dim strResult As String
strResult = ""
If ReportDetail(i).value2 <> Nothing Then
For j = 0 To Globals.ThisWorkbook.tbSheet.Rows.Count - 1
strResult = strResult & "R" & (j + ReportDetail(0).Cells.Row + 2) & "C" & (i + 1) & ","
Next
If strResult <> "" Then
strResult = strResult.Remove(strResult.Length - 1, 1)
End If
If i = 0 Then
Me.Range(Chr(Asc("A") + i) & listRows).Value2() = strName
Else
Me.Range(Chr(Asc("A") + i) & listRows).FormulaR1C1 = "=" & strFunction & "(" & strResult & ")"
End If
End If
Next
End Sub
'绑定标题部分的控件,绑定详细部分的控件,数据显示的标题,如"最大力、最大变形"等, 绑定单位
Private Sub BindNamedRange()
'绑定标题部分的控件
ReportTitle.Add(NamedRange1)
ReportTitle.Add(NamedRange2)
ReportTitle.Add(NamedRange3)
ReportTitle.Add(NamedRange4)
ReportTitle.Add(NamedRange5)
ReportTitle.Add(NamedRange6)
ReportTitle.Add(NamedRange7)
ReportTitle.Add(NamedRange8)
ReportTitle.Add(NamedRange9)
ReportTitle.Add(NamedRange10)
ReportTitle.Add(NamedRange11)
ReportTitle.Add(NamedRange12)
ReportTitle.Add(NamedRange13)
ReportTitle.Add(NamedRange14)
ReportTitle.Add(NamedRange15)
ReportTitle.Add(NamedRange16)
ReportTitle.Add(NamedRange17)
ReportTitle.Add(NamedRange18)
ReportTitle.Add(NamedRange19)
ReportTitle.Add(NamedRange20)
ReportTitle.Add(NamedRange21)
ReportTitle.Add(NamedRange22)
ReportTitle.Add(NamedRange23)
ReportTitle.Add(NamedRange24)
ReportTitle.Add(NamedRange25)
ReportTitle.Add(NamedRange26)
ReportTitle.Add(NamedRange27)
ReportTitle.Add(NamedRange28)
ReportTitle.Add(NamedRange29)
ReportTitle.Add(NamedRange30)
ReportTitle.Add(NamedRange31)
ReportTitle.Add(NamedRange32)
ReportTitle.Add(NamedRange33)
ReportTitle.Add(NamedRange34)
ReportTitle.Add(NamedRange35)
ReportTitle.Add(NamedRange36)
ReportTitle.Add(NamedRange37)
ReportTitle.Add(NamedRange38)
ReportTitle.Add(NamedRange39)
ReportTitle.Add(NamedRange40)
ReportTitle.Add(NamedRange41)
ReportTitle.Add(NamedRange42)
ReportTitle.Add(NamedRange43)
ReportTitle.Add(NamedRange44)
ReportTitle.Add(NamedRange45)
ReportTitle.Add(NamedRange46)
ReportTitle.Add(NamedRange47)
ReportTitle.Add(NamedRange48)
ReportTitle.Add(NamedRange49)
ReportTitle.Add(NamedRange50)
ReportTitle.Add(NamedRange51)
ReportTitle.Add(NamedRange52)
ReportTitle.Add(NamedRange53)
ReportTitle.Add(NamedRange54)
ReportTitle.Add(NamedRange55)
ReportTitle.Add(NamedRange56)
ReportTitle.Add(NamedRange57)
ReportTitle.Add(NamedRange58)
ReportTitle.Add(NamedRange59)
ReportTitle.Add(NamedRange60)
ReportTitle.Add(NamedRange61)
ReportTitle.Add(NamedRange62)
ReportTitle.Add(NamedRange63)
'显示备注字段
ReportTitle.Add(NamedRange64)
'绑定详细部分的控件,数据显示的标题,如"最大力、最大变形"等
Select Case Globals.ThisWorkbook.tbSheet.Rows(0).Item("试样形状")
Case "板材"
NamedRange66.Value2 = "宽度"
NamedRange67.Value2 = "厚度"
Case "棒材"
NamedRange66.Value2 = "直径"
NamedRange67.Value2 = ""
Case "管材"
NamedRange66.Value2 = "外径"
NamedRange67.Value2 = "内径"
Case Else
NamedRange66.Value2 = "截面"
NamedRange67.Value2 = ""
End Select
ReportDetail.Add(NamedRange65)
ReportDetail.Add(NamedRange66)
ReportDetail.Add(NamedRange67)
ReportDetail.Add(NamedRange68)
ReportDetail.Add(NamedRange69)
ReportDetail.Add(NamedRange70)
ReportDetail.Add(NamedRange71)
ReportDetail.Add(NamedRange72)
ReportDetail.Add(NamedRange73)
ReportDetail.Add(NamedRange74)
ReportDetail.Add(NamedRange75)
ReportDetail.Add(NamedRange76)
ReportDetail.Add(NamedRange77)
ReportDetail.Add(NamedRange78)
ReportDetail.Add(NamedRange79)
'绑定单位
ReportDetailUnit.Add(NamedRange80)
ReportDetailUnit.Add(NamedRange81)
ReportDetailUnit.Add(NamedRange82)
ReportDetailUnit.Add(NamedRange83)
ReportDetailUnit.Add(NamedRange84)
ReportDetailUnit.Add(NamedRange85)
ReportDetailUnit.Add(NamedRange86)
ReportDetailUnit.Add(NamedRange87)
ReportDetailUnit.Add(NamedRange88)
ReportDetailUnit.Add(NamedRange89)
ReportDetailUnit.Add(NamedRange90)
ReportDetailUnit.Add(NamedRange91)
ReportDetailUnit.Add(NamedRange92)
ReportDetailUnit.Add(NamedRange93)
ReportDetailUnit.Add(NamedRange94)
'绑定标题部分的控件读取数据库中的数据
ReportTitleRead()
'绑定详细部分的控件读取数据库中的数据
Try
'TableRead("#######0.00")
Dim listRows As Integer = Globals.ThisWorkbook.tbSheet.Rows.Count
listRows = ReportDetail(0).Cells.Row + 2 + listRows
' 在数据后面添加统计值,如“最大值”“最小值”“平均值”等
If myUserControl.CkbMaxValue.Checked = True Then
sheetResult("最大值", "Max", listRows)
End If
If myUserControl.CkbMedValue.Checked = True Then
sheetResult("中值", "Median", listRows + 1)
End If
If myUserControl.CkbMinValue.Checked = True Then
sheetResult("最小值", "Min", listRows + 2)
End If
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
'绑定标题部分的控件读取数据库中的数据
Public Function ReportTitleRead() As Boolean
Dim temp As Integer
Dim rowDB As DataRow
Dim i As Integer
Dim j As Integer
Dim count As Integer
count = ReportTitle.Count - 2
Try
For i = 0 To count Step 3
If Trim(ReportTitle(i).value2) <> "" Then
For j = 0 To Globals.ThisWorkbook.tbSheet.Columns.Count - 1
If ReportTitle(i).value2 = Globals.ThisWorkbook.strChange(0, j) Then
Me.ReportTitle(i + 1).DataBindings.clear()
Me.ReportTitle(i + 1).DataBindings.Add("value2", Globals.ThisWorkbook.tbSheet, Globals.ThisWorkbook.strChange(1, j))
temp = Globals.ThisWorkbook.DBChange.GetUnitID(Globals.ThisWorkbook.strChange(1, j))
rowDB = Globals.ThisWorkbook.tbUnit.Rows.Find(temp)
If rowDB Is Nothing Then
Else
ReportTitle(i + 2).value2 = rowDB("Label")
End If
Exit For
End If
Next
End If
Next
Me.ReportTitle(63).DataBindings.Add("value2", Globals.ThisWorkbook.tbSheet, "备注")
Catch ex As ArgumentNullException
MessageBox.Show(Globals.ThisWorkbook.strChange(1, j))
MessageBox.Show("数据库没有 " & ReportTitle(i).value2 & " 字段!请重新输入后保存再打开文件!" & ex.Message)
Return False
Catch ex As Exception
MessageBox.Show(ex.Message)
Return False
End Try
Return (True)
End Function
Private Sub Sheet1_Shutdown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shutdown
End Sub
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -