一、vb如何导出为excel表格
Public Sub OutExcelA()
On Error Resume Next
Dim blnApplicationVisible As Boolean
Dim blnWorkBookOpen As Boolean
Dim jj As Integer
Dim NN As Integer
Dim t As Integer
Dim Irow, Icol As Integer
MkDir App.Path & "输出Excel"
MkDir App.Path & "输出Excel" & Me.Caption
MDIFrmmain.MousePointer = 11
Set objExcel = GetObject(, "Excel.Application")
Select Case Err.Number
Case 0
blnWorkBookOpen = True
Case 429
Set objExcel = CreateObject("Excel.Application")
blnWorkBookOpen = False
Case Else
End Select
objExcel.Visible = False
blnFind = False
blnApplicationVisible = objExcel.Visible
Dim ab As String
ab = Date & "-" & Second(Now) & Me.Caption & ".xls"
If Dir(App.Path & "输出Excel" & Me.Caption & "" & ab) <> "" Then '找到相应的文件
For i = 1 To objExcel.Workbooks.Count
Set objBook = objExcel.Workbooks(i)
If objBook.Name = Me.Caption Then
blnFind = True
Exit For
End If
Next i
If blnFind = True Then
objBook.Activate
Else
Set objBook = objExcel.Workbooks.Open(App.Path & "输出Excel" & Me.Caption & "" & ab)
End If
Else
Set objBook = objExcel.Workbooks.Add()
End If
If blnFind Then
Objsheet.Activate
Objsheet.Range("a1", "z100").Delete
Else
Set Objsheet = objBook.Worksheets.Add
Objsheet.Name = Me.Caption
End If
Dim ColsA As Integer
ColsA = Grid.Cols - 1
Dim ColsAZM As String
Dim ZM As String
ColsAZM = Chr(ColsA + 97) '转为字母
Dim jjj As Integer
Objsheet.Select
With Objsheet
.Range("a1", ColsAZM & "1").Merge
.Range("a1", ColsAZM & "1").Font.Name = "宋体"
.Range("a1", ColsAZM & "1").Font.Size = 13
.Range("a1", ColsAZM & "1").Value = Me.Caption
.Range("a1", ColsAZM & "1").Font.Bold = True
.Range("a2", ColsAZM & "2").Merge
.Range("a2", ColsAZM & "2").Font.Name = "宋体"
.Range("a2", ColsAZM & "2").Font.Size = 12
.Range("a2", ColsAZM & "2").Value = LabXS.Caption
.Range("a2", ColsAZM & "2").Font.Bold = False
On Error Resume Next
NN = Grid.Rows + 2
'************ 居中 *************************************
.Range("a1", ColsAZM & NN).HorizontalAlignment = xlCenter
.Range("a1", ColsAZM & NN).VerticalAlignment = xlCenter
.Range("a1", ColsAZM & NN).WrapText = False
.Range("a1", ColsAZM & NN).Orientation = 0
.Range("a1", ColsAZM & NN).AddIndent = False
.Range("a1", ColsAZM & NN).ShrinkToFit = False
'************* END *****************************************
jj = 0
For t = 3 To NN
For jjj = 0 To Grid.Cols - 1
ZM = Chr(jjj + 97)
.Range(ZM & CStr(t)) = Grid.TextMatrix(jj, jjj)
Next
'---------------------显示进度--------------------
DoEvents
MDIFrmmain.Pro1.Visible = True
MDIFrmmain.StatusBar1.Panels(1).Text = "正在输出到EXCEL文件并保存文件到:" & App.Path & "输出Excel" & Me.Caption & " 中 请稍候..."
MDIFrmmain.Pro1.Max = NN
MDIFrmmain.Pro1.Value = t
'---------------------显示进度--------------------
jj = jj + 1
Next
For jjj = 0 To Grid.Cols - 1
ZM = Chr(jjj + 97) & ":" & Chr(jjj + 97)
Objsheet.Columns(ZM).ColumnWidth = Grid.ColWidth(jjj) / 114
Next
Objsheet.Range("A3:" & ColsAZM & NN).Borders.LineStyle = xlContinuous '*******加边框
ActiveWindow.DisplayGridlines = False
If Not blnWorkBookOpen Then
objExcel.DisplayAlerts = False ' True
End If
End With
Call DaYingSeZhi
objBook.SaveAs App.Path & "输出Excel" & Me.Caption & "" & ab
objExcel.Visible = True
Set objExcel = Nothing
Set objBook = Nothing
Set Objsheet = Nothing
MDIFrmmain.Pro1.Visible = False
MDIFrmmain.StatusBar1.Panels(1).Text = Me.Caption & " 输出完成并已经保存在:" & App.Path & "输出Excel" & Me.Caption & " 中"
MDIFrmmain.MousePointer = 0
End Sub
上面模块是我自己用的一个VB输出EXCEL模块,希望对你有用
二、vb中如何将数据导出到excel
介绍
下面通过一步一步的介绍,如何通过VB.NET来读取数据,并且将数据导入到Excel中。
第一步:
打开VS开发工具,并且添加引用。
然后选择。
Microsoft Excel 12.0 object library and。
Microsoft Excel 14.0 object library。
第二步:
创建一个Excle在你的电脑中。
第三步:
在VS中写入如下代码:
Imports System.Data
Imports System.Data.SqlClient
Imports Excel = Microsoft.Office.Interop.Excel。
Public Class excel
‘添加按钮
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
Handles Button1.Click
Try
'创建连接
Dim cnn As DataAccess = New DataAccess(CONNECTION_STRING)
Dim i, j As Integer
'创建Excel对象
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlWorkBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
xlApp = New Microsoft.Office.Interop.Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Add(misValue)
' 打开某一个表单
xlWorkSheet = xlWorkBook.Sheets("sheet1")
' sql查询
' xlWorkBook.Sheets.Select("A1:A2")
Dim sql As String = "SELECT * FROM EMP"
' SqlAdapter
Dim dscmd As New SqlDataAdapter(sql, cnn.ConnectionString)
' 定义数据集
Dim ds As New DataSet
dscmd.Fill(ds)
‘添加字段信息到Excel表的第一行
xlWorkSheet.Cells(1, 1).Value = "First Name"
xlWorkSheet.Cells(1, 2).Value = "Last Name"
xlWorkSheet.Cells(1, 3).Value = "Full Name"
xlWorkSheet.Cells(1, 4).Value = "Salary"
' 将数据导入到excel
For i = 0 To ds.Tables(0).Rows.Count - 1
'Column
For j = 0 To ds.Tables(0).Columns.Count - 1
' this i change to header line cells >>>
xlWorkSheet.Cells(i + 3, j + 1) = _
ds.Tables(0).Rows(i).Item(j)
Next
Next
'HardCode in Excel sheet
' this i change to footer line cells >>>
xlWorkSheet.Cells(i + 3, 7) = "Total"
xlWorkSheet.Cells.Item(i + 3, 8) = "=SUM(H2:H18)"
' 保存到Excel
xlWorkSheet.SaveAs("D:vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)
'弹出对话框显示保存后的路径
MsgBox("You can find the file D:vbexcel.xlsx")
Catch ex As Exception
End Try
End Sub
' Function of Realease Object in Excel Sheet
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
复制代码。
第四步:
看到如下导出结果。