⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sheet1.vb

📁 .net中word的扩展应用。用ado.net对word,excel进行存取_ADO.NET应用
💻 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 + -