vb.net : 把datagridview中的内容下载为excel，如果有下拉框的话，也一并下载，然后再上传

当前界面（frmOuterEntity）中有一个datagridview，其名称为 dgv_entity，其中有些单元格是下拉框（DataGridViewComboBoxCell），现在想把其中的内容下载到excel表，有下拉框的话一并下载下来：

Private Sub _frmOuterEntity_Load(sender As Object, e As EventArgs) Handles Me.Load

Dim dt_entity As DataTable = getDataTable_entity()

With dgv_entity

            .AllowUserToAddRows = False
            .AllowUserToDeleteRows = False
            .AllowUserToOrderColumns = False

.DataSource = dt_entity

            .Columns(0).Width = 210
            .Columns(1).Width = 100
            .Columns(2).Width = 320

            .Columns(0).SortMode = DataGridViewColumnSortMode.NotSortable
            .Columns(1).SortMode = DataGridViewColumnSortMode.NotSortable
            .Columns(2).SortMode = DataGridViewColumnSortMode.NotSortable

            .Columns(0).ReadOnly = True
            .Columns(1).ReadOnly = True
            '.Rows(0).Cells(2).ReadOnly = True    '   客户号，999999，表示外部实体，不可更改
            .Columns(0).DefaultCellStyle.BackColor = Color.LightGray
            .Columns(1).DefaultCellStyle.BackColor = Color.LightGray
            '.Rows(0).Cells(2).Style.BackColor = Color.LightGray   ' 淡灰色，表示不可更改

'''''''''''''''''''''''''''''''''''''''''''''''''

            Dim strCmd = "select code SEVC,rpad(code,length(code),' ')||rpad(' ',2,' ')||code_desc SEVC_desc " &
                                        "from tbl_aml_config where code_category='SEVC_CTVC' order by code_sequence"
            'oReturnReader = fillBoxesT(cboSEVC, strCmd, "SEVC", "SEVC_desc")
            Dim dt = getDataTableFromCmd(strCmd)
            Dim dtgCol As New DataGridViewComboBoxCell
            dtgCol.DataSource = dt
            dtgCol.DisplayMember = "SEVC_desc"
            dtgCol.ValueMember = "SEVC"
            .Rows(1).Cells(2) = dtgCol

''''''''''''''''''''

            strCmd = "select code citp,rpad(code,length(code),' ')||rpad(' ',2,' ')||code_desc citp_desc " &
                                                    "from tbl_aml_config where code_category='SETP_SRIT_SCIT_CITP_TBIT_TCIT' order by code_sequence"
            ' oReturnReader = fillBoxesT(cboSRIT, strCmd, "citp", "citp_desc")
            dt = getDataTableFromCmd(strCmd)

            Dim dtgCol_srit As New DataGridViewComboBoxCell
            dtgCol_srit.DataSource = dt
            dtgCol_srit.DisplayMember = "citp_desc"
            dtgCol_srit.ValueMember = "citp"
            .Rows(11).Cells(2) = dtgCol_srit

            Dim dtgCol_orit As New DataGridViewComboBoxCell
            dtgCol_orit.DataSource = dt
            dtgCol_orit.DisplayMember = "citp_desc"
            dtgCol_orit.ValueMember = "citp"
            .Rows(12).Cells(2) = dtgCol_orit

            Dim dtgCol_scit As New DataGridViewComboBoxCell
            dtgCol_scit.DataSource = dt
            dtgCol_scit.DisplayMember = "citp_desc"
            dtgCol_scit.ValueMember = "citp"
            .Rows(15).Cells(2) = dtgCol_scit

            Dim dtgCol_ocit As New DataGridViewComboBoxCell
            dtgCol_ocit.DataSource = dt
            dtgCol_ocit.DisplayMember = "citp_desc"
            dtgCol_ocit.ValueMember = "citp"
            .Rows(16).Cells(2) = dtgCol_ocit

End With

End Sub

' 把当前dgv中的内容下载到excel文件，包括下拉框
Private Sub btn_download_Click(sender As Object, e As EventArgs) Handles btn_download.Click

        ' excel 文件名
        Dim excelFileName As String = "testDownload_outerEntiryInfo_" & User_ID & "_" & Date.Now.ToString("yyyyMMdd") & ".xlsx"
        excelFileName = My.Settings.XMLPath & "\" & excelFileName    '   在配置的位置输出

        Dim dt_datas As DataTable = dgv_entity.DataSource
        If dt_datas.Rows.Count = 0 Then
            MessageBox.Show("当前没有找到符合条件的记录，无法下载")
            Return
        End If

Dim objArray(dt_datas.Rows.Count + 1, dt_datas.Columns.Count) As Object ' 准备写入excel表格的二维矩阵

For jj = 0 To dt_datas.Columns.Count - 1 ' 对于各列

            ' 各列的列头
            Dim ss As String() = dt_datas.Columns(jj).Caption.Split(".")
            objArray(0, jj) = ss(ss.Length - 1).ToUpper    ' 列头大写

            ' 以下各行的具体数据
            For ii = 0 To dt_datas.Rows.Count - 1
                objArray(ii + 1, jj) = dt_datas.Rows(ii).Item(jj).ToString
            Next

' 上面将dgv写入二维矩阵中
' 下面将二维矩阵输出到excel

        Dim excelApplication As New Microsoft.Office.Interop.Excel.Application
        excelApplication.Visible = False
        Dim excelWorkBook As Microsoft.Office.Interop.Excel.Workbook = excelApplication.Workbooks.Add()

        'Dim excelWorkSheet As Excel.Worksheet = excelWorkBook.Worksheets.Add
        'excelWorkSheet.Name = "table0"   ' 自己定义的表名；注意 Sheet1\Sheet2\Sheet3是excel文件中自带的三个表名，这里由于是增加新表，所以不能用这三个表名
        ' 如果上面这行代码被屏蔽（就是没有指定表名），则使用 Sheet4 表名
        Dim excelWorkSheet As Microsoft.Office.Interop.Excel.Worksheet = excelWorkBook.Worksheets(1) ' 用现有的表名 Sheet1 ，注意 Worksheets 是从1开始

        '    根据矩阵的大小设定 excel表格的操作区域
        Dim range As Microsoft.Office.Interop.Excel.Range = excelWorkSheet.Range("A1").Resize(objArray.GetLength(0), objArray.GetLength(1))
        range.NumberFormat = "@"
        range.HorizontalAlignment = Microsoft.Office.Interop.Excel.XlHAlign.xlHAlignGeneral
        range.VerticalAlignment = Microsoft.Office.Interop.Excel.XlVAlign.xlVAlignCenter

range.Value = objArray ' 赋值

''''''''''''''''''''''''''''''''''''''''''''''''///

        With dgv_entity
            For i = 0 To .Rows.Count - 1
                For j = 0 To .Rows(i).Cells.Count - 1

If TypeOf .Rows(i).Cells(j) Is DataGridViewComboBoxCell Then ' 如果这个单元格是 DataGridViewComboBoxCell

'MessageBox.Show("行" & i & " 列" & j & " 是 DataGridViewComboBoxCell ")

Dim o As DataGridViewComboBoxCell = DirectCast(.Rows(i).Cells(j), DataGridViewComboBoxCell)

WriteArray_comboBox_cell(excelWorkBook, excelWorkSheet, i + 2, j + 1, o)

End If

                Next
            Next
        End With
        '''''''''''''''''''''''''''''''''''''''''''''''''\\\

        '' 设定 excel 的单元格大小
        With excelWorkSheet
            .Cells.RowHeight = 20
            .Cells.ColumnWidth = 20
        End With

Try

            excelWorkBook.SaveAs(excelFileName)      '   保存为 excel文件，位置根据配置文件
            '   这里以excelFileName文件名进行保存，这个文件总是存在的，会弹出一个对话框，问要不要覆盖
            '      用户点击对话框的 Yes 按钮，就会把这个文件覆盖掉，然后在 excel 里打开新的文件

        Catch ex As Exception ' 如果出问题
            ' 这里出问题的原因就是用户没有点击 Yes 按钮，而是点击了 No 或者 Cancel 按钮
            '     此时可以以其他文件名保存

'MessageBox.Show(excelFileName & " 文件现在无法保存，原因：" & ex.ToString() & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "您可以用其它文件名进行保存，请在接下来的输入框中输入文件名")
'MessageBox.Show(excelFileName & " 文件现在无法保存，您可以用其它文件名进行保存，请在接下来的输入框中输入文件名")

' 在excel文件无法保存的情况下，另外保存
Dim SaveFileDialog1 As SaveFileDialog = New SaveFileDialog

SaveFileDialog1.CheckFileExists = False ' 不检查文件是否已经存在，似乎无用？

            ' SaveFileDialog1.Filter = "file excel(*.csv)|*.csv"
            ' 上面以前，以 csv 作为文件名的后缀，不够灵活
            ' 下面现在，以输入文件名的后缀作为文件名的后缀； 20191118
            Dim ss As String() = excelFileName.Split("\")   ' 获取文件名（去掉路径信息）
            Dim sss As String() = ss(ss.Length - 1).Split(".")    '   获取文件名的后缀
            SaveFileDialog1.Filter = "file excel(*." & sss(1) & ")|*." & sss(1)

            SaveFileDialog1.FilterIndex = 2
            SaveFileDialog1.RestoreDirectory = True
            If SaveFileDialog1.ShowDialog = System.Windows.Forms.DialogResult.OK Then
                excelWorkBook.SaveAs(SaveFileDialog1.FileName)     ' 重新起个名字保存
            End If

End Try

'MessageBox.Show("Download completed!")
excelApplication.Visible = True

        ' 收集垃圾，关闭进程
        ReleaseComObject(excelApplication)
        ReleaseComObject(excelWorkBook)

'ReleaseComObject(excelWorkSheet)
'Return excelWorkSheet ' 返回 WorkSheet，以便用户对其进行一些后期处理（比如对某些区域上色等等）

        '   返回 excelWorkSheet
        If IsNothing(excelWorkSheet) Then ' 如果返回的excelWorkSheet 是空值（下载时出错了）
            Return   ' 退出
        End If

        ' 对返回的excelWorkSheet 进行一些操作，比如：改变某些部分的颜色
        Dim cellStart = excelWorkSheet.Cells(2, 3)
        Dim cellEnd = excelWorkSheet.Cells(dt_datas.Rows.Count + 1, dt_datas.Columns.Count)
        With excelWorkSheet.Range(cellStart, cellEnd).Interior
            .Color = Color.Yellow      '   颜色设为黄
        End With

ReleaseComObject(excelWorkSheet) ' 回收垃圾

End Sub

Public Sub WriteArray_comboBox_cell(excelWorkbook As Microsoft.Office.Interop.Excel.Workbook, excelWorksheet As Microsoft.Office.Interop.Excel.Worksheet _
, rowIndex As Int16, columnIndex As Int16, o As DataGridViewComboBoxCell)

        Dim dt = DirectCast(o.DataSource, DataTable)   ' 类型转换
        Dim dts(dt.Rows.Count - 1, 0) As Object     ' 表示是否可疑的一列，Y N；必须用这两个列举值
        For ii = 0 To dt.Rows.Count - 1
            dts(ii, 0) = dt.Rows(ii)(o.DisplayMember).ToString()
        Next

Dim columnName As String

Dim excelWorksheet2 As Microsoft.Office.Interop.Excel.Worksheet = Nothing
excelWorksheet2 = excelWorkbook.Worksheets.Add

excelWorksheet2.Visible = False

Dim cellStart As Object
'Dim cellEnd As Object

cellStart = excelWorksheet2.Cells(rowIndex, columnIndex)

        'columnName = Left(cellStart.Address, Len(cellStart.Address) - 2)
        columnName = cellStart.Address.ToString.Trim.Substring(0, 2)
        'Console.WriteLine(" cellStart.Address : " & cellStart.Address)
        'Console.WriteLine(" Len(cellStart.Address) - 2 : " & Len(cellStart.Address) - 2)
        'Console.WriteLine(" columnName = " & columnName)
        '                 cellStart.Address : $T$1   ; 即
        '        Len(cellStart.Address) - 2 : 2
        '                        columnName = $T

Dim rangeColumn As Microsoft.Office.Interop.Excel.Range
rangeColumn = excelWorksheet2.Range(cellStart, cellStart).Resize(dts.Length, 1) ' Resize：若干行，一列

rangeColumn.Value = dts

cellStart = excelWorksheet.Cells(rowIndex, columnIndex)
'cellEnd = excelWorksheet.Cells(objectArray.GetLength(0), columnIndex)

' With excelWorksheet.Range(cellStart, cellEnd).Validation ' 对这一列的各个单元格进行赋值
With excelWorksheet.Range(cellStart, cellStart).Validation ' 对这一列的第一个单元格进行赋值

.Delete()

            ' VBA
            .Add(Type:=Microsoft.Office.Interop.Excel.XlDVType.xlValidateList _
                                 , AlertStyle:=Microsoft.Office.Interop.Excel.XlDVAlertStyle.xlValidAlertStop _
                                 , Operator:=Microsoft.Office.Interop.Excel.XlFormatConditionOperator.xlBetween _
                                 , Formula1:="=" & excelWorksheet2.Name & "!" & columnName & ":" & columnName)

            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With

ReleaseComObject(excelWorksheet2)

End Sub

Private Sub btn_upload_Click(sender As Object, e As EventArgs) Handles btn_upload.Click

        'OpenFileDialog1.InitialDirectory = myEXCELPath
        OpenFileDialog1.Filter = "Excel file(*.xlsx)|*.xlsx"
        OpenFileDialog1.FilterIndex = 1
        OpenFileDialog1.RestoreDirectory = True
        OpenFileDialog1.Multiselect = False
        OpenFileDialog1.CheckFileExists = True

        Dim myEXCELPath As String = My.Settings.EXCELPath
        Dim myEXCELFileName As String
        If OpenFileDialog1.ShowDialog() = System.Windows.Forms.DialogResult.OK Then   ' 如果打开了某个文件
            myEXCELFileName = OpenFileDialog1.FileName    ' 文件名
        Else
            Return
        End If

        If Not FileIO.FileSystem.FileExists(myEXCELFileName) Then   ' 如果文件不存在
            MsgBox("File[" & myEXCELFileName & "] not exist.")
            Return
        End If

SetRemarks(lbl_show, Color.Blue, "Wait a moment...")
Cursor.Current = Cursors.WaitCursor

'Dim remarkstext As String = STRING_EMPTY

' Dim uploadedRecordsCount = 0 ' 上传记录的数量

'Try

If uploadFile(myEXCELFileName) = True Then ' 如果上传成功

SetRemarks(lbl_show, SystemColors.ControlText, "uploaded successfully!")

        Else ' 如果上传失败
            SetRemarks(lbl_show, Color.Red, "upload failed ")
        End If

        'Catch ex As Exception
        '    SetRemarks(lblRemarks, Color.Red, "System Error...Please contact IT helpdesk.")
        '    MsgBox(ex.Message)

'End Try

Cursor.Current = Cursors.Default

    End Sub
    ' 上下传承
    Private Function uploadFile(myEXCELFileName As String) As Boolean

Dim myConn As New ADODB.Connection

myConn.CursorLocation = ADODB.CursorLocationEnum.adUseClient

        'Dim connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        '          "Data Source=" & myEXCELFileName & ";" & _
        '          "Extended Properties='Excel 12.0 Xml; HDR=NO; IMEX=1'"
        Dim connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" &
                  "Data Source=" & myEXCELFileName & ";" &
                  "Extended Properties='Excel 12.0 Xml; HDR=YES; IMEX=1'"

        Try
            myConn.Open(connStr)      '     把excel作为数据源
        Catch ex As Exception
            MessageBox.Show(myEXCELFileName & "文件现在可能已经被打开了，不能上传。请先关闭它")
            Return False
        End Try

Dim rs As New ADODB.Recordset

Dim SHEET_NAME = "Sheet1"
rs.Open("Select * From [" & SHEET_NAME & "$]", myConn, ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic)

        Dim dt_fromExcel As New DataTable
        For i = 0 To rs.Fields.Count - 1        '   dataTable 添加列
            dt_fromExcel.Columns.Add(New DataColumn(rs.Fields(i).Name, GetType(String)))
        Next

        Dim da As New System.Data.OleDb.OleDbDataAdapter()
        da.Fill(dt_fromExcel, rs)   ' 把读取的记录先放到 dataTable 中
        rs.Close()
        myConn.Close()
        rs = Nothing
        da = Nothing
        myConn = Nothing

' 下面对 dataTable 进行操作

uploadFile2(dt_fromExcel) ' 正式上传

ReleaseComObject(dt_fromExcel) ' 放开这个东东，否则excel process 依然会保存在内存中，直到退出程序

Return True

    End Function
    ' 上下传承
    Private Function uploadFile2(dt_fromExcel As DataTable) As Boolean

'update dtgAML
For i = 0 To dt_fromExcel.Rows.Count - 2 ' 对于 excel dataTable中的每一行

'uploadFile3(i, dt_fromExcel) ' 上传
Dim strValue = dt_fromExcel.Rows(i).Item(2).ToString.Trim

strValue = strValue.Split(" ")(0).Trim

'MessageBox.Show(strContent)

dgv_entity.Rows(i).Cells(2).Value = strValue

Return True

End Function

posted @ 2020-01-13 17:09 gaoleionline 阅读(382) 评论(0) 收藏举报

刷新页面返回顶部

vb.net : 把datagridview中的内容下载为excel，如果有下拉框的话，也一并下载，然后再上传

公告