VB.NET DATAGRIDVIEW数据导出Excel

sub datagridviewtoExcel()

Dim xlapp As New Excel.Application()

xlapp.Visible = True

Dim rowc As Integer = prt_dgv.Rows.Count

Dim colc As Integer = prt_dgv.Columns.Count

Dim dCC As Integer = 1

Dim row As Integer = 0

xlapp.Application.Workbooks.Add(True)

xlapp.Caption = pdt_coding.Text & " - " & Now

Dim xlbook As Excel.Workbook

Dim xlsheet As Excel.Worksheet

xlbook = xlapp.ActiveWorkbook

xlsheet = xlbook.ActiveSheet

xlsheet.Name = pdt_coding.Text '设置工作表名称

If colc < 1 Then

MessageBox.Show("没有数据可供导出 ", "提示 ", MessageBoxButtons.OK, MessageBoxIcon.Information)

Return

End If

If rowc < 1 Then

MessageBox.Show("没有数据可供导出 ", "提示 ", MessageBoxButtons.OK, MessageBoxIcon.Information)

Return

End If

Dim i As Integer = 0

While i <= prt_dgv.ColumnCount - 1

If prt_dgv.Columns(i).Visible = True _

AndAlso prt_dgv.Columns(i).HeaderText.Trim() <> "删除" _

AndAlso prt_dgv.Columns(i).HeaderText.Trim() <> "" Then

xlapp.Cells(1, dCC) = prt_dgv.Columns(i).HeaderText.Trim()

dCC = dCC + 1

End If

i = i + 1

End While

While row <= prt_dgv.RowCount - 1

dCC = 1

Dim col As Integer = 0

While col < colc

If prt_dgv.Columns(col).Visible = True _

AndAlso prt_dgv.Columns(col).HeaderText <> "删除" _

AndAlso prt_dgv.Columns(col).HeaderText.Trim() <> "" Then

Try

Dim Val As String = prt_dgv.Rows(row).Cells(col).Value.ToString().Trim()

If Val.Length > 8 Then

Val = "'" + Val

End If

xlapp.Cells(row + 2, dCC) = Val

dCC = dCC + 1

Catch generatedExceptionName As Exception

End Try

End If

col = col + 1

End While

row = row + 1

End While

'xl表格样式

xlsheet.Cells.Borders.Color = Color.White

With xlsheet.UsedRange

.Borders.Color = Color.Black

.Font.Name = "微软雅黑"

.Font.Size = 11

.HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

.VerticalAlignment = Excel.XlHAlign.xlHAlignCenter

End With

With xlsheet.Range("a1:ah1")

.Interior.Color = Color.DarkGray

.Font.Size = 13

.Font.Name = "微软雅黑"

End With

xlsheet.Cells.EntireColumn.AutoFit()

xlsheet.Select()

'---------------------------------------------------

msgbox "部件导出--成功！！"

xlsheet = Nothing

xlbook = Nothing

xlapp = Nothing

End Sub