Hi,
I have two codes that work perfectly seperate, but now I want to combine them.
What I want to do, is that I want to select records via a checkbox and after I press a command button, the checkbox should switch back to FALSE (automatically) and the selected records should be automated been shown in a Excel table.
I'm trying to manage this now since a long time and can't quite figure out how it works...
Heres the code for resetting the checkbox:
Private Sub cmd_Check_click()
With Me.Recordset
Do While Not .EOF
If !Compare = True Then
Call .Edit
!Compare = False
Call .Update
End If
Call .MoveNext
Loop
End With
End Sub
Heres the Code for jumping to the Excel file (Just could manage to export all records to a Excel sheet...):
Option Compare Database
Option Explicit
Private Sub SaveRecordsetToExcelRange()
' Excel constants:
Const strcXLPath As String = "C:\Users\qxn4964\Desktop\Dateien\Arbeit\Datasheet \Excel\Example\MyWorkbook.xls"
Const strcWorksheetName As String = "Sheet1"
Const strcCellAddress As String = "B2"
' Access constants:
Const strcQueryName As String = "Vehicle queries"
' Excel Objects:
Dim objXL As Excel.Application
Dim objWBK As Excel.Workbook
Dim objWS As Excel.Worksheet
Dim objRNG As Excel.Range
' DAO objects:
Dim objDB As DAO.Database
Dim objQDF As DAO.QueryDef
Dim objRS As DAO.Recordset
On Error GoTo Error_Exit_SaveRecordsetToExcelRange
' Open a DAO recordset on the query:
Set objDB = CurrentDb()
Set objQDF = objDB.QueryDefs(strcQueryName)
Set objRS = objQDF.OpenRecordset
' Open Excel and point to the cell where
' the recordset is to be inserted:
Set objXL = New Excel.Application
objXL.Visible = True
Set objWBK = objXL.Workbooks.Open(strcXLPath)
Set objWS = objWBK.Worksheets(strcWorksheetName)
Set objRNG = objWS.Range(strcCellAddress)
objRNG.CopyFromRecordset objRS
' Destroy objects:
GoSub CleanUp
Exit_SaveRecordsetToExcelRange:
Exit Sub
CleanUp:
' Destroy Excel objects:
Set objRNG = Nothing
Set objWS = Nothing
Set objWBK = Nothing
Set objXL = Nothing
' Destroy DAO objects:
If Not objRS Is Nothing Then
objRS.Close
Set objRS = Nothing
End If
Set objQDF = Nothing
Set objDB = Nothing
Return
Error_Exit_SaveRecordsetToExcelRange:
MsgBox "Error " & Err.Number _
& vbNewLine & vbNewLine _
& Err.Description, _
vbExclamation + vbOKOnly, _
"Error Information"
GoSub CleanUp
Resume Exit_SaveRecordsetToExcelRange
End Sub
Hope you can help me out.
Thanks.
Nadal