Can I export table data to Excel In a set Format? (1 Viewer)

[mission2java_78]

Keep me in mind when you become a rich access guru.

Better yet send check payable to me

Jon

 

[chewy]

haha. You bet. Who do you dend your checks to?

 

[mission2java_78]

who do i dend my checks to?

Whats that

 

[chewy]

send

 

[mission2java_78]

hehe

If you were the owner of where you worked I might charge you but im certainly not charging you chewy.

Jon

 

[chewy]

Just for anyones reference in the future the I had to run this again with a few changes to clear the file before I enter the new data into it.


Private Sub Command4_Click()
Dim answer As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim objXL As Excel.Application
Dim objXLWrkBk As Excel.Workbook
Dim objXLWrkSht As Excel.Worksheet
Dim lngStartRange As Long
Dim myCount As Variant
Dim count As Integer

If StartDate > EndDate Then
MsgBox StartDate & " is after " & EndDate & vbCrLf & "Start date can not be after End date" & vbCrLf & vbCrLf & vbCrLf & "Change before you can proceed!", vbExclamation, "Date Error"
Else

strSQL = "SELECT * FROM qryMain WHERE Date BETWEEN #" & StartDate & "# AND #" & EndDate & "#"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

If rs.BOF Then

'no records
MsgBox "There are no records for the dates entered!"
Else
myCount = DCount("[CustomerID]", "qryCount")

lngStartRange = 5 'start at row 5
Set objXL = CreateObject("Excel.Application")
Set objXLWrkBk = objXL.Workbooks.Open("M:\Book Keeping\Matt Majewski Procedures\Ferris Lockbox\Ferris Ind.xls")
Set objXLWrkSht = objXLWrkBk.Worksheets("Sheet1") 'takes the name of the tab in Excel in your case sheet1
objXLWrkSht.Range("A1").Activate

count = 5
While count <> 200

objXL.Cells(lngStartRange, "A").Value = ""
objXL.Cells(lngStartRange, "B").Value = ""
objXL.Cells(lngStartRange, "C").Value = ""
objXL.Cells(lngStartRange, "D").Value = ""
objXL.Cells(lngStartRange, "E").Value = ""

lngStartRange = lngStartRange + 1 'increment the row for next customer
'rs.MoveNext 'move to next customer
count = count + 1
Wend
objXLWrkBk.Close SaveChanges:=True
objXL.Quit

If rs.BOF Then
'no records
MsgBox "There were no reocerds withe the date range you specified!"

Else
lngStartRange = 5 'start at row 5
Set objXL = CreateObject("Excel.Application")
Set objXLWrkBk = objXL.Workbooks.Open("M:\Book Keeping\Matt Majewski Procedures\Ferris Lockbox\Ferris Ind.xls")
Set objXLWrkSht = objXLWrkBk.Worksheets("Sheet1") 'takes the name of the tab in Excel in your case sheet1
objXLWrkSht.Range("A1").Activate

While Not rs.EOF

objXL.Cells(lngStartRange, "A").Value = rs("CustomerName").Value
objXL.Cells(lngStartRange, "B").Value = rs("CustomerNumber").Value
objXL.Cells(lngStartRange, "C").Value = rs("CheckNumber").Value
objXL.Cells(lngStartRange, "D").Value = rs("InvoiceNumber").Value
objXL.Cells(lngStartRange, "E").Value = rs("CheckAmount").Value

lngStartRange = lngStartRange + 1 'increment the row for next customer
rs.MoveNext 'move to next customer
Wend

objXL.Cells(lngStartRange, "A").Value = "Total"
objXL.Cells(lngStartRange, "E").Value = "=SUM(E5:E" & (lngStartRange - 1) & ")"
answer = MsgBox("Do you really want to print two copies of this?", vbYesNo, "Congirm Print")
If answer = vbYes Then
objXLWrkSht.PrintOut 1, 2, 2
'beep
MsgBox " PRINT OUT DONE!! "
End If
objXLWrkBk.Close SaveChanges:=True
objXL.Quit

End If
Done:
Set rs = Nothing
Set db = Nothing
Set objXL = Nothing
Set objXLWrkBk = Nothing
Set objXLWrkSht = Nothing


End If

 

[chewy]

One final question. Then I put this to rest. Ho would I set a particular attribute to a particular cell. Say I want cell "A34" to be Bold? How could I do this in VBA? THanks

 

[mission2java_78]

objXLWrkSht or whatever you called the work sheet

objXLWrkSht.Range("A1").Select
objXLWrkSht.Selection.Font.Bold=True

Jon

 

[chewy]

it highlights selection and gives the error method or data member not found

 

[mission2java_78]

post your code

 

[chewy]

Private Sub Command4_Click()
Dim answer As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim objXL As Excel.Application
Dim objXLWrkBk As Excel.Workbook
Dim objXLWrkSht As Excel.Worksheet
Dim lngStartRange As Long
Dim myCount As Variant
Dim count As Integer

If StartDate > EndDate Then
MsgBox StartDate & " is after " & EndDate & vbCrLf & "Start date can not be after End date" & vbCrLf & vbCrLf & vbCrLf & "Change before you can proceed!", vbExclamation, "Date Error"
Else

strSQL = "SELECT * FROM qryMain WHERE Date BETWEEN #" & StartDate & "# AND #" & EndDate & "#"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

If rs.BOF Then

'no records
MsgBox "There are no records for the dates entered!"
Else
myCount = DCount("[CustomerID]", "qryCount")
'If myCount > 30 Then
' MsgBox "You have more than 30 entries for the dates specified! The data will be exported but you will have to format the spreadsheet. Sorry!"
'Else

lngStartRange = 5 'start at row 5
Set objXL = CreateObject("Excel.Application")
Set objXLWrkBk = objXL.Workbooks.Open("M:\Book Keeping\Matt Majewski Procedures\Ferris Lockbox\Ferris Ind.xls")
Set objXLWrkSht = objXLWrkBk.Worksheets("Sheet1") 'takes the name of the tab in Excel in your case sheet1
objXLWrkSht.Range("A1").Activate

count = 5
While count <> 200

objXL.Cells(lngStartRange, "A").Value = ""
objXL.Cells(lngStartRange, "B").Value = ""
objXL.Cells(lngStartRange, "C").Value = ""
objXL.Cells(lngStartRange, "D").Value = ""
objXL.Cells(lngStartRange, "E").Value = ""

lngStartRange = lngStartRange + 1 'increment the row for next customer
'rs.MoveNext 'move to next customer
count = count + 1
Wend
objXLWrkBk.Close SaveChanges:=True
objXL.Quit

If rs.BOF Then
'no records
MsgBox "There were no reocerds withe the date range you specified!"

Else
lngStartRange = 5 'start at row 5
Set objXL = CreateObject("Excel.Application")
Set objXLWrkBk = objXL.Workbooks.Open("M:\Book Keeping\Matt Majewski Procedures\Ferris Lockbox\Ferris Ind.xls")
Set objXLWrkSht = objXLWrkBk.Worksheets("Sheet1") 'takes the name of the tab in Excel in your case sheet1
objXLWrkSht.Range("A1").Activate

While Not rs.EOF

objXL.Cells(lngStartRange, "A").Value = rs("CustomerName").Value
objXL.Cells(lngStartRange, "B").Value = rs("CustomerNumber").Value
objXL.Cells(lngStartRange, "C").Value = rs("CheckNumber").Value
objXL.Cells(lngStartRange, "D").Value = rs("InvoiceNumber").Value
objXL.Cells(lngStartRange, "E").Value = rs("CheckAmount").Value

lngStartRange = lngStartRange + 1 'increment the row for next customer
rs.MoveNext 'move to next customer
Wend

objXL.Cells(lngStartRange, "A").Value = "Total"
objXL.Cells(lngStartRange, "E").Value = "=SUM(E5:E" & (lngStartRange - 1) & ")"
objXLWrkSht.Range("A6").Select
objXLWrkSht.Selection.Font.Bold = True


answer = MsgBox("Do you really want to print two copies of this?", vbYesNo, "Congirm Print")
If answer = vbYes Then
objXLWrkSht.PrintOut 1, 2, 2
'beep
MsgBox " PRINT OUT DONE!! "
End If
objXLWrkBk.Close SaveChanges:=True
objXL.Quit
'End If


End If
Done:
Set rs = Nothing
Set db = Nothing
Set objXL = Nothing
Set objXLWrkBk = Nothing
Set objXLWrkSht = Nothing


End If

Call email
End If

End Sub

 

[mission2java_78]

change

objXLWrkSht.Range("A6").Select 
objXLWrkSht.Selection.Font.Bold = True

to

with objXL
    .Range("A6").Select 
    .Selection.Font.Bold = True 
end with

Jon

 

[chewy]

Awesome. Works great!

 

[mission2java_78]

Cool beans

Jon