-
RE: Query tìm kiếm giá trị trống
doandinhtam > 24-06-22, 05:37 PM
Mình cũng thử nghiên cứu search = vba như ongke nêu, nhưng có 1 vấn đề là mình không biết cách xuất kết quả tìm kiếm được ra excel nên mình mới search = query để tiện cho xuất ra excel. Mong ongke hỗ trợ mình đoạn code xuất từ form (search = vba) ra excel ạ -
RE: Query tìm kiếm giá trị trống
ongke0711 > 24-06-22, 05:58 PM
Trên diễn đàn có rồi, bạn tìm kiếm đi. -
RE: Query tìm kiếm giá trị trống
doandinhtam > 25-06-22, 09:54 AM
Mình tìm nhưng không thấy ongke ơi. Bạn có file tham khảo không cho mình xin file ạ -
RE: Query tìm kiếm giá trị trống
ongke0711 > 25-06-22, 03:30 PM
(25-06-22, 09:54 AM)doandinhtam Đã viết: Mình tìm nhưng không thấy ongke ơi. Bạn có file tham khảo không cho mình xin file ạ
Bên dưới là code xuất ra Excel.
Nếu Form tìm kiếm dùng câu lệnh SQL để lấy dữ liệu kết quả và làm nguồn cho SubForm thì truyền câu lệnh SQL đó vào làm tham số cho hàm:
Ví dụ:
Mã:sSQL = Select * From tblABC"
...
...
Call DataToExcel (sSQL)
Mã:Function DataToExcel(sSQL As String, Optional strWorkbookPath As String, Optional strTargetSheetName As String)
Dim rst As DAO.Recordset
Dim excelApp As Object
Dim Wbk As Object
Dim Sht As Object
Dim xlRng As Object
Dim fldHeadings As DAO.Field
'Lay du lieu cho recordset (table hoac query).
Set rst = CurrentDb.OpenRecordset(sSQL)
'Tao phiên làm viec Excel moi.
Set excelApp = CreateObject("Excel.Application")
On Error Resume Next
'Try to open the specified workbook. If there is no workbook specified
'(or if it cannot be opened) create a new one and rename the target sheet.
Set Wbk = excelApp.Workbooks.Open(strWorkbookPath)
If Err.Number <> 0 Or Len(strWorkbookPath) = 0 Then
Set Wbk = excelApp.Workbooks.Add
Set Sht = Wbk.Worksheets("Sheet1")
If Len(strTargetSheetName) > 0 Then
Sht.Name = Left(strTargetSheetName, 34)
End If
End If
'If the specified workbook has been opened correctly, then in order to avoid
'problems with other sheets that might contain, a new sheet is added and is
'being renamed according to the strTargetSheetName.
Set Sht = Wbk.Worksheets.Add
If Len(strTargetSheetName) > 0 Then
Sht.Name = Left(strTargetSheetName, 34)
End If
On Error GoTo 0
excelApp.Visible = True
On Error GoTo ErrorHandler
'Copy dòng tiêu de.
For Each fldHeadings In rst.Fields
excelApp.ActiveCell = fldHeadings.Name
excelApp.ActiveCell.Offset(0, 1).Select
Next
'Copy du lieu xuong sheet.
rst.MoveFirst
Sht.range("A2").Select
Sht.range("A2").CopyFromRecordset rst
Sht.range("1:1").Select
'Dinh dang dòng tiêu de.
excelApp.Selection.Font.Bold = True
With excelApp.Selection
.HorizontalAlignment = -4108 '= xlCenter in Excel.
.VerticalAlignment = -4108 '= xlCenter in Excel.
.WrapText = False
End With
Set xlRng = Sht.UsedRange
With xlRng
.Font.Name = "Verdana"
.Font.Size = 8
With .Borders
.ColorIndex = -4105 'xlAutomatic
.LineStyle = 1 'xlContinuous
.Weight = 2 'xlThin
End With
With .Rows(1)
.Font.Bold = True
.Interior.ColorIndex = 15
End With
.WrapText = False
.EntireColumn.AutoFit
End With
excelApp.ActiveSheet.Cells.EntireColumn.AutoFit
With excelApp.ActiveWindow
.FreezePanes = False
.ScrollRow = 1
.ScrollColumn = 1
End With
Sht.Rows("2:2").Select
excelApp.ActiveWindow.FreezePanes = True
With Sht
.Tab.Color = RGB(255, 0, 0)
.range("A1").Select
End With
rst.Close
Set rst = Nothing
Exit Function
ErrorHandler:
Msgbox "Ma loi: " & Err.Number & vbNewLine & "Noi dung loi: " & Err.Description, vbExclamation, "Thong bao"
Exit Function
End Function