Tác giả: truongphu
Mô tả: Nhiều thắc mắc về vấn đề nầy, tôi viết sub RectoExcel tặng các bạn
Hay không?

Project cách dùng:
vietteiv wrote:test bị lỗi
vietteiv wrote:pc nhà dùng excel 2010
truongphu wrote:vietteiv wrote:
pc nhà dùng excel 2010
chịu khó mần từng record sang row
truongphu wrote:Private Sub RecorsetToExcel(ByVal Reco As Recordset, FName As String)
Code: Select all
Public Sub RtoE(ByVal sql As String, Optional SheetName As String = "")
On Error GoTo Err
Dim Rst As New ADODB.Recordset
Dim FldCount As Integer
Dim iCol As Integer
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Set xlApp = CreateObject("Excel.Application") 'Create an instance of Excel and add a workbook
If Val(xlApp.Version) > 8 And Val(xlApp.Version) < 15 Then 'EXCEL 2000,2002,2003,2007,2010
Set xlWb = xlApp.Workbooks.Add
If sql <> "" Then
Rst.Open sql, Cn ' Open recordset from Table want to export
Set xlWs = xlWb.Worksheets(1)
If SheetName <> "" Then xlWb.ActiveSheet.Name = SheetName
xlApp.Visible = True
xlApp.UserControl = True
FldCount = Rst.Fields.Count 'Copy field names to the first row of the worksheet
For iCol = 1 To FldCount
xlWs.Cells(1, iCol).Value = Rst.Fields(iCol - 1).Name
Next
xlWs.Cells(2, 1).CopyFromRecordset Rst 'Note: CopyFromRecordset will fail if the recordset contains an OLE object field or array data such as hierarchical recordsets
Rst.Close
xlApp.Selection.CurrentRegion.Columns.AutoFit 'Auto-fit the column widths and row heights
xlApp.Selection.CurrentRegion.Rows.AutoFit
End If
Set Rst = Nothing
Else
MsgBox "Khong ho tro phien ban Excel dang cai dat."
End If
End Sub
Users browsing this forum: No registered users and 1 guest