Hi Guys
I am using this code on an access forms on click event to export data to excel
the code below works really well and setup the layout of my worksheet as required
how ever, i cant get my head around how to use conditoinal formatting,
basically what i want to do so change the text colour of all dates in the range .Range("C" & iRowStart).Value to red if the date exported is less than or equal to todays date
really sorry if this has been asked before
Many thanks
Steve
I am using this code on an access forms on click event to export data to excel
the code below works really well and setup the layout of my worksheet as required
Code:
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim SQL As String
Dim Rs1 As DAO.Recordset
Dim iRowStart As Integer
Const xlCenter = -4108
Const xlleft = -4131 'xlRight is -4152
Const xlCellValue = 1
Const xlGreater = 5
' Const xlExpression = 2
Dim oObj As Object
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
' No Outlook is not open, try and create object
Err.Clear
Set oObj = CreateObject("Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excel Is Either Not Installed Or Is Unavalible You Can Not Export To Excel"
Err.Clear
Exit Sub
End If
End If
SQL = "SELECT tblTechRequests.TechRequestNumber AS [TR Number], tblTechRequests.DaysDate AS [TR Raised On], " & _
"tblTechRequests.DueByDAte AS [Due By], tblTechRequests.FirstResponceDAte AS [First Responded On], " & _
"tblTechRequests.AuthorsName AS [Raised By], tblTechRequests.MachineName AS [Machine Name], " & _
"tblTechRequests.PartNumber AS [Part Number], tblTechRequests.ReasonForTR AS [Reason For TR], " & _
"tblTechRequests.Status, tblTechRequests.TRWatingTechnicalTime AS [Time Waiting Technical], " & _
"tblTechRequests.TRClosureTime AS [TR Closure Time], tblTechRequests.TRMachineDownTime AS [Machine Down Time] FROM tblTechRequests"
'Execute query and populate recordset
Set Rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
'If no data, don't bother opening Excel, just quit
If Rs1.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
Exit Sub
Else
'We Shall Turn On The Hour Glass, So That Users Know That Something Is Happening
DoCmd.Hourglass (True)
'Create an instance of Excel and start building a spreadsheet Late Binding Used So No References Required
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add() 'start a new workbook
Set xlSheet = xlBook.Worksheets(1)
With xlSheet
.Name = "Technical Request Data"
.Cells.Font.Name = "Franklin Gothic Book"
.Cells.Font.Size = 10
'Format range as required To Bold a Cell use this for example .Range("A1").Cells.Font.Bold = True
.Range("A1", "H1").Merge
.Range("A1").Columns.AutoFit
.Range("A2", "H2").Merge
.Range("A2").Columns.AutoFit
.Range("A1").HorizontalAlignment = xlleft
.Range("A2").HorizontalAlignment = xlleft
.Range("A1").Cells.Font.Name = "Franklin Gothic Book"
.Range("A2").Cells.Font.Name = "Franklin Gothic Book"
.Range("A1").Cells.Font.Size = 12
.Range("A2").Cells.Font.Size = 10
.Range("A1").Value = DLookup("[CompanyName]", "[tblSettings]", "[ID]=1") & " " & "Technical Request System Data " '= "Company Aged Creditors Report"
.Range("A2").Value = "Exported ON" & " - " & Date
'Now We Shall Build The Colum Headings.value is the text required
.Range("A4").Value = "TR Number"
.Range("B4").Value = "TR Raised On"
.Range("C4").Value = "Due By"
.Range("D4").Value = "First Responded On"
.Range("E4").Value = "Raised By"
.Range("F4").Value = "Machine Name"
.Range("G4").Value = "Part Number"
.Range("H4").Value = "Reason For TR"
.Range("i4").Value = "Status"
.Range("j4").Value = "Time Waiting Technical"
.Range("k4").Value = "TR Closure Time"
.Range("l4").Value = "Machine Down Time"
'Format Column Headings set the text to the left on A4 so it looks nice, then center the values in the range B7:G3000 so all values are centered
.Range("A4:l4").Cells.Font.Bold = True
.Range("A4:l4").HorizontalAlignment = xlCenter
.Range("A4:l4").Columns.AutoFit
'Format using these examples .Columns("A").NumberFormat = "$#,##0.00;-$#,##0.00"
.Columns("D").NumberFormat = "dd/mm/yyyy"
.Columns("C").NumberFormat = "dd/mm/yyyy"
'iRowStart is the row that the starting row that the recordset will enter data into
iRowStart = 7
'Then we Loop through recordset above and copy data from recordset until we get to the end of file
Do While Not Rs1.EOF
'start importing the data from the record set above into the required columns A,B,C,D,E,F,G in this example
.Range("A" & iRowStart).Value = Nz(Rs1![TR Number], "")
.Range("A" & iRowStart).Columns.AutoFit
.Range("A" & iRowStart).HorizontalAlignment = xlCenter
.Range("A" & iRowStart).ColumnWidth = 15
.Range("B" & iRowStart).Value = Nz(Rs1![TR Raised On], "")
.Range("B" & iRowStart).Columns.AutoFit
.Range("B" & iRowStart).HorizontalAlignment = xlCenter
.Range("B" & iRowStart).ColumnWidth = 18
.Range("C" & iRowStart).Value = Nz(Rs1![Due By], 0)
.Range("C" & iRowStart).Columns.AutoFit
.Range("C" & iRowStart).HorizontalAlignment = xlCenter
.Range("C" & iRowStart).ColumnWidth = 15
.Range("D" & iRowStart).Value = Nz(Rs1![First Responded On], 0)
.Range("D" & iRowStart).Columns.AutoFit
.Range("D" & iRowStart).HorizontalAlignment = xlCenter
.Range("D" & iRowStart).ColumnWidth = 20
.Range("E" & iRowStart).Value = Nz(Rs1![Raised By], 0)
.Range("E" & iRowStart).Columns.AutoFit
.Range("E" & iRowStart).HorizontalAlignment = xlCenter
.Range("E" & iRowStart).ColumnWidth = 15
.Range("F" & iRowStart).Value = Nz(Rs1![Machine Name], 0)
.Range("F" & iRowStart).Columns.AutoFit
.Range("F" & iRowStart).HorizontalAlignment = xlCenter
.Range("F" & iRowStart).ColumnWidth = 20
.Range("G" & iRowStart).Value = Nz(Rs1![Part Number], 0)
.Range("G" & iRowStart).Columns.AutoFit
.Range("G" & iRowStart).HorizontalAlignment = xlCenter
.Range("G" & iRowStart).ColumnWidth = 20
.Range("H" & iRowStart).Value = Nz(Rs1![Reason For TR], 0)
.Range("H" & iRowStart).Columns.AutoFit
.Range("H" & iRowStart).HorizontalAlignment = xlCenter
.Range("H" & iRowStart).ColumnWidth = 28
.Range("I" & iRowStart).Value = Nz(Rs1![Status], 0)
.Range("I" & iRowStart).Columns.AutoFit
.Range("I" & iRowStart).HorizontalAlignment = xlCenter
.Range("I" & iRowStart).ColumnWidth = 20
'Column J,K and L do not need the width set as the colum header is wider than the dasta bening entered
.Range("J" & iRowStart).Value = Nz(Rs1![Time Waiting Technical], 0)
.Range("J" & iRowStart).HorizontalAlignment = xlCenter
.Range("K" & iRowStart).Value = Nz(Rs1![TR Closure Time], 0)
.Range("K" & iRowStart).HorizontalAlignment = xlCenter
.Range("L" & iRowStart).Value = Nz(Rs1![Machine Down Time], 0)
.Range("L" & iRowStart).HorizontalAlignment = xlCenter
iRowStart = iRowStart + 1
Rs1.MoveNext
Loop
'then we set a footer, we start this two rows below the last entry and leave a gap of 3 rows and format the footer nicely
iRowStart = iRowStart + 2
.Range("A" & iRowStart).Value = "All Data Exported From The Technical Request System."
.Range("A" & iRowStart).Font.Color = vbRed
.Range("A" & iRowStart).HorizontalAlignment = xlleft
.Range("A" & iRowStart).Cells.Font.Bold = True
End With
DoCmd.Hourglass False
xlApp.Visible = True
Rs1.Close
Set Rs1 = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
On Error GoTo 0
Exit Sub
End Ifhow ever, i cant get my head around how to use conditoinal formatting,
basically what i want to do so change the text colour of all dates in the range .Range("C" & iRowStart).Value to red if the date exported is less than or equal to todays date
really sorry if this has been asked before
Many thanks
Steve
