Hi, I'll post the code I used to make a report move over to excel..
Private Sub Toggle110_Click()
' Declare All my Objects
Dim rs As Recordset
Dim rs1 As Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim qdfItem As QueryDef
Dim qdfTitle As QueryDef
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet1 As Excel.Worksheet
Dim xlSheet2 As Excel.Worksheet
Dim ClaimNumber As Variant
Dim DateOfLoss As Variant
Dim AdjName As Variant
Dim AdjPhone As Variant
Dim AdjFax As Variant
Dim AdjEmail As Variant
Dim InsName As Variant
Dim InsAddress As Variant
Dim InsCity As Variant
Dim InsState As Variant
Dim InsZip As Variant
Dim InsPhone As Variant
Dim InsWorkPhone As Variant
Dim InsEmail As Variant
' Populate the qdfItem with the qryExcelItem Record set
Set qdfItem = CurrentDb.QueryDefs("qryExcelItems")
qdfItem.Parameters(0) = Forms!frmClaims!idsClaimNumber
Set rs = qdfItem.OpenRecordset
rs.MoveLast: rs.MoveFirst
' Get the number of column and rows
intMaxCol = rs.Fields.Count
intMaxRow = rs.RecordCount
' Populate the qdfTitle with the qryExcelTitle Record Set and Get the info in the right Variants
Set qdfTitle = CurrentDb.QueryDefs("qryExcelTitle")
qdfTitle.Parameters(0) = Forms!frmClaims!idsClaimNumber
Set rs1 = qdfTitle.OpenRecordset
ClaimNumber = rs1.Fields.Item("idsClaimNumber").Value
DateOfLoss = rs1.Fields.Item("dtmDateofLoss").Value
AdjName = rs1.Fields.Item("Adjuster Name").Value
AdjPhone = rs1.Fields.Item("chrAdjPhone").Value
AdjFax = rs1.Fields.Item("chrAdjFax").Value
AdjEmail = rs1.Fields.Item("chrAdjEmail").Value
InsName = rs1.Fields.Item("Insured Name").Value
InsAddress = rs1.Fields.Item("chrInsAddress").Value
InsCity = rs1.Fields.Item("chrInsCity").Value
InsState = rs1.Fields.Item("chrInsState").Value
InsZip = rs1.Fields.Item("chrInsZip").Value
InsPhone = rs1.Fields.Item("chrHomePhone").Value
InsWorkPhone = rs1.Fields.Item("chrWorkPhone").Value
InsEmail = rs1.Fields.Item("chrEmail").Value
' Check if data is in the record set, If so then create the Excel App
If rs1.RecordCount > 0 Then
rs1.MoveLast: rs1.MoveFirst ' I have no idea what this does
Set xlApp = New Excel.Application
With xlApp
Set xlBook = .Workbooks.Add
Set xlSheet1 = xlBook.Worksheets("Sheet1")
Set xlSheet2 = xlBook.Worksheets("Sheet2")
End With
End If
' Make the App visible and format the cells
With xlApp
.Visible = True
With xlSheet1
With .Range(.Cells(1, 1), .Cells(18, 2))
.Font.Size = 12
.ColumnWidth = 40
.Font.Italic = True
.Font.Bold = True
.HorizontalAlignment = Excel.XlVAlign.xlVAlignCenter
End With
.Cells(1, 1) = "EndClaim Property Loss Worksheet"
With .Cells(1, 1).Font
.Size = 20
.Bold = True
End With
With .Cells(1, 1).Interior
.ColorIndex = 15
End With
With .Range(.Cells(1, 1), .Cells(1, 2))
.Merge (True)
End With
.Cells(2, 1) = "Claim Information:"
With .Cells(2, 1).Font
.Size = 16
.Bold = True
End With
.Cells(2, 1).HorizontalAlignment = Excel.XlVAlign.xlVAlignJustify
With .Cells(2, 1).Interior
.ColorIndex = 15
End With
With .Range(.Cells(2, 1), .Cells(2, 2))
.Merge (True)
End With
.Cells(3, 1) = "Date Of Loss:"
.Cells(3, 2) = DateOfLoss
.Cells(4, 1) = "Claim Number:"
.Cells(4, 2) = ClaimNumber
.Cells(5, 1) = "Adjuster Information:"
.Cells(5, 1).HorizontalAlignment = Excel.XlVAlign.xlVAlignJustify
With .Cells(5, 1).Font
.Size = 16
.Bold = True
End With
With .Cells(5, 1).Interior
.ColorIndex = 15
End With
With .Range(.Cells(5, 1), .Cells(5, 2))
.Merge (True)
End With
.Cells(6, 1) = "Adjuster Name:"
.Cells(6, 2) = AdjName
.Cells(7, 1) = "Adjuster Phone:"
.Cells(7, 2) = AdjPhone
.Cells(8, 1) = "Adjuster Fax:"
.Cells(8, 2) = AdjFax
.Cells(9, 1) = "Adjuster Email:"
.Cells(9, 2) = AdjEmail
.Cells(10, 1) = "Insured Information:"
.Cells(10, 1).HorizontalAlignment = Excel.XlVAlign.xlVAlignJustify
With .Cells(10, 1).Font
.Size = 16
.Bold = True
End With
With .Cells(10, 1).Interior
.ColorIndex = 15
End With
With .Range(.Cells(10, 1), .Cells(10, 2))
.Merge (True)
End With
.Cells(11, 1) = "Insured Name:"
.Cells(11, 2) = InsName
.Cells(12, 1) = "Insured Address:"
.Cells(12, 2) = InsAddress
.Cells(13, 1) = "Insured City:"
.Cells(13, 2) = InsCity
.Cells(14, 1) = "Insured State:"
.Cells(14, 2) = InsState
.Cells(15, 1) = "Insured Zip:"
.Cells(15, 2) = InsZip
.Cells(16, 1) = "Insured Phone:"
.Cells(16, 2) = InsPhone
.Cells(17, 1) = "Insured Work Phone:"
.Cells(17, 2) = InsWorkPhone
.Cells(18, 1) = "Insured Email:"
.Cells(18, 2) = InsEmail
With .Range(.Cells(1, 1), .Cells(18, 2)).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End With
End With
' Clean up
Set rs1 = Nothing
Set qdfTitle = Nothing
Set xlSheet1 = Nothing
' Populate the 2nd sheet with the data from the qryExcelItems query and format the cells
With xlApp
With xlSheet2
.Range(.Cells(2, 1), .Cells(intMaxRow, intMaxCol)).CopyFromRecordset rs
.Cells(intMaxRow + 2, 4).Value = "=Sum(D2
" & intMaxRow + 1 & ")"
.Cells(intMaxRow + 2, 5).Value = "=Sum(E2:E" & intMaxRow + 1 & ")"
.Cells(intMaxRow + 2, 7).Value = "=Sum(G2:G" & intMaxRow + 1 & ")"
.Cells(intMaxRow + 2, 8).Value = "=Sum(H2:H" & intMaxRow + 1 & ")"
.Range(.Cells(1, 1), .Cells(1, 9)).Font.Size = 16
.Range(.Cells(intMaxRow + 2, 1), .Cells(intMaxRow + 2, 9)).Font.Color = vbGreen
.Cells(1, 1) = "Qty"
.Cells(1, 2) = "Lost Item"
.Cells(1, 3) = "Replacing Item"
.Cells(1, 4) = "Retail Price"
.Cells(1, 5) = "Our Price"
.Cells(1, 6) = "Depreciation"
.Cells(1, 7) = "Depreciation Amount"
.Cells(1, 8) = "Extended Price"
.Cells(1, 9) = "Replacing"
.Range(.Cells(1, 1), .Cells(1, 9)).Interior.ColorIndex = 15
.Columns(1).ColumnWidth = 5
.Columns(2).ColumnWidth = 34
.Columns(3).ColumnWidth = 38
.Columns(4).ColumnWidth = 13
.Columns(5).ColumnWidth = 11
.Columns(6).ColumnWidth = 15
.Columns(7).ColumnWidth = 24
.Columns(8).ColumnWidth = 18
.Columns(9).ColumnWidth = 12
.Range(.Cells(2, 1), .Cells(intMaxRow + 2, intMaxCol)).Font.Size = 12
.Range(.Cells(2, 1), .Cells(intMaxRow + 2, intMaxCol)).Font.Italic = True
.Range(.Cells(2, 1), .Cells(intMaxRow + 2, intMaxCol)).Font.Bold = True
.Range(.Cells(1, 1), .Cells(1, 9)).Font.Size = 12
.Range(.Cells(1, 1), .Cells(1, 9)).Font.Bold = True
.Columns(4).NumberFormat = "$#,##0.00"
.Columns(5).NumberFormat = "$#,##0.00"
.Columns(6).NumberFormat = "##0%"
.Columns(7).NumberFormat = "$#,##0.00"
.Columns(8).NumberFormat = "$#,##0.00"
End With
End With
' This is to change the tabs on the excel form and to delete the extra sheet
' I can't get this to work every other time
xlApp.Sheets("Sheet1").Name = "CoverSheet"
xlApp.Sheets("Sheet2").Name = "Detail"
xlApp.Worksheets("Sheet3").Delete
' Clean up
Set rs = Nothing
Set qdfItem = Nothing
Set xlSheet2 = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
I hope this helps. I tend to learn by looking and copying. If you have any questions let me know. I tried to comment on the code Iused the best I could. I really hope this helps. I've gotten so much help from this board.
