Hi Carl,
I was hoping to copy the code from an Excel Macro to format a spreadsheet after I'd created and populated it in Access. Some reports are exported into Excel and then used for other uses by different managers.
So, naively, I cut and pasted the macro from Excel into the Access code where I generated the Spreadsheet and thought that I might just be lucky enough to correct a few lines and end up with a formatted spreadsheet directly from the database.
Silly me, eh?
Having little knowledge of Excel I can see I've bitten off more than I can chew here...that's why I like databases.
I'm sure I can do it, eventually...
This is where I am at the moment... The following code is on a Command button.
If Not IsNothing(Me!Searchstr) Then
DoCmd.SetWarnings False
DoCmd.RunSQL ("SELECT Property.Property, Space_Room_Data.Block, Space_Room_Data.Floor, Space_Room_Data.Rm_No, [Faculties and Depts].FacDiv, [Faculties and Depts].DeptName, Space_Room_Type.TypeDesc, Space_Room_Use.RmUsDesc,Space_Room_Data.Area INTO ExportTableDept FROM Space_Room_Type RIGHT JOIN (Space_Room_Use RIGHT JOIN ([Faculties and Depts] RIGHT JOIN (Property LEFT JOIN Space_Room_Data ON Property.BuildingCode = Space_Room_Data.BuildingCode) ON [Faculties and Depts].Dept_Code = Space_Room_Data.DataDept) ON Space_Room_Use.RmUs_Code = Space_Room_Data.DataUse) ON Space_Room_Type.Type_Code = Space_Room_Data.DataType WHERE " & Searchstr & " ORDER BY Property.Property, Space_Room_Data.Block, Space_Room_Data.Floor, Space_Room_Data.Rm_No;")
DoCmd.SetWarnings True
DoCmd.OutputTo acOutputTable, "ExportTableDept", acFormatXLS, "D:\PropertyExportByDept.xls", False
Dim xlApp As Object
Dim xlSheet As Object
Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.WorkBooks.Open("D:\PropertyExportByDept.xls").Sheets(1)
With xlApp
.Application.Cells.Select
.Application.Selection.RowHeight = 45
.Application.Rows("1:1").Select
.Application.HorizontalAlignment = -4108 'xlCenter
.Application.VerticalAlignment = -4108
.Application.WrapText = True
.Application.Orientation = 0
.Application.AddIndent = False
.Application.IndentLevel = 0
.Application.ShrinkToFit = False
.Application.ReadingOrder = -5002 'xlContext
.Application.MergeCells = False
.Application.Rows("1:1").Select
.Application.Selection.Font.Bold = True
.Application.Range("D1").Select
.Application.ActiveCell.FormulaR1C1 = "Room No"
.Application.ActiveCell.Characters(START:=1, Length:=7).Font
.Application.FontStyle = "Bold"
.Application.Size = 10
.Application.Strikethrough = False
.Application.Superscript = False
.Application.Subscript = False
.Application.OutlineFont = False
.Application.Shadow = False
.Application.Underline = -4142 'xlUnderlineStyleNone
.Application.ColorIndex = 1
.Application.Range("E1").Select
.Application.ActiveCell.FormulaR1C1 = "Fac/Div"
.Application.ActiveCell.Characters(START:=1, Length:=7).Font
.Application.FontStyle = "Bold"
.Application.Size = 10
.Application.Strikethrough = False
.Application.Superscript = False
.Application.Subscript = False
.Application.OutlineFont = False
.Application.Shadow = False
.Application.Underline = -4142 'xlUnderlineStyleNone
.Application.ColorIndex = 1
.Application.Range("F1").Select
.Application.ActiveCell.FormulaR1C1 = "Dept Name"
.Application.ActiveCell.Characters(START:=1, Length:=9).Font
.Application.Application.FontStyle = "Bold"
.Application.Size = 10
.Application.Strikethrough = False
.Application.Superscript = False
.Application.Subscript = False
.Application.OutlineFont = False
.Application.Shadow = False
.Application.Underline = -4142 'xlUnderlineStyleNone
.Application.ColorIndex = 1
.Application.Range("G1").Select
.Application.ActiveCell.FormulaR1C1 = "Room Type"
.Application.ActiveCell.Characters(START:=1, Length:=9).Font
.Application.FontStyle = "Bold"
.Application.Size = 10
.Application.Strikethrough = False
.Application.Superscript = False
.Application.Subscript = False
.Application.OutlineFont = False
.Application.Shadow = False
.Application.Underline = -4142 'xlUnderlineStyleNone
.Application.ColorIndex = 1
.Application.Range("H1").Select
.Application.ActiveCell.FormulaR1C1 = "Room Use"
.Application.ActiveCell.Characters(START:=1, Length:=8).Font
.Application.FontStyle = "Bold"
.Application.Size = 10
.Application.Strikethrough = False
.Application.Superscript = False
.Application.Subscript = False
.Application.OutlineFont = False
.Application.Shadow = False
.Application.Underline = -4142 'xlUnderlineStyleNone
.Application.ColorIndex = 1
.Application.Columns("I:I").Select
.Application.Selection.NumberFormat = "0.00"
.Application.Columns("A:I").Select
.Application.ActiveSheet.PageSetup.PrintArea = "$A:$I"
.Application.ActiveSheet.PageSetup
.Application.PrintTitleRows = "$1:$1"
.Application.PrintTitleColumns = ""
.Application.ActiveSheet.PageSetup.PrintArea = "$A:$I"
.Application.ActiveSheet.PageSetup
.Application.LeftHeader = ""
.Application.CenterHeader = "&""Arial,Bold""&12Faculty Space&""Arial,Regular""&10 " & Chr(10) & ""
.Application.RightHeader = ""
.Application.LeftFooter = "&D"
.Application.CenterFooter = ""
.Application.RightFooter = ""
.Application.LeftMargin = Application.InchesToPoints(0.75)
.Application.RightMargin = Application.InchesToPoints(0.75)
.Application.TopMargin = Application.InchesToPoints(1)
.Application.BottomMargin = Application.InchesToPoints(1)
.Application.HeaderMargin = Application.InchesToPoints(0.5)
.Application.FooterMargin = Application.InchesToPoints(0.5)
.Application.PrintHeadings = False
.Application.PrintGridlines = False
.Application.PrintComments = -4142 'xlPrintNoComments
.Application.PrintQuality = 600
.Application.CenterHorizontally = False
.Application.CenterVertically = False
.Application.Orientation = 2 'xlLandscape
.Application.Draft = False
.Application.PaperSize = 9 'xlPaperA4
.Application.FirstPageNumber = -4105 'xlAutomatic
.Application.Order = 1 'xlDownThenOver
.Application.BlackAndWhite = False
.Application.Zoom = False
.Application.FitToPagesWide = 1
.Application.FitToPagesTall = 363
.Application.PrintErrors = 0 'xlPrintErrorsDisplayed
End With
Set xlApp = Nothing
Set xlSheet = Nothing
xlApp.ActiveWorkBook.Save
xlApp.ActiveWorkBook.Close
xlApp.Quit
MsgBox "The data has been exported into a spreadsheet." & Chr$(10) & Chr$(10) & "The Spreadsheet is called 'PropertyExportbyDept.xls' and will be in your local D: directory"
Else
MsgBox "No Search criteria set - Go back and make selections", vbExclamation, "No Search Criteria"
End If
It's a mess, I know. I've been trying it from different angles and advice and search results on the forum so the Macro doesn't look like it used to...
Any help would gratefully appreciated. But I'm asking a lot, I know.
Dave
