A
Andy
Here is what I need to do, just need to tie it all in with VBA for Excel
from within Access
I export my data into an excel spreadsheet, autofilter and arranfge column
widths, then e-mail to an exchange folder, all from VBA
I now want to also colour code the rows depending on the value in one of the
columns.
1) Determine number of rows to be placed on excel (this should equate to
number of records + 1)
dim reccount
reccount = DCount("ID", "Inventory")
2) For correctness, discount row1 (this is a heading row)
Just start from D2
3) select range D2 to Dx (column D has required value)
use a loop D2 to reccount
4) could possibly use loop and case to determine value of cells
if Planning found in cell dx, colour the row in blue, if Engineers found,
colour red, or leave uncoloured if neither value found
e.g.
dim Counter
For Counter = 2 To reccount Step 1
If Not IsError(.Value) Then
Select Case .Value
Case "Planning"
.Interior.ColorIndex = 45
Case "Engineers"
.Interior.ColorIndex = 20
End Select
End If
Next Counter
or
Sub Check_Range_Value()
Dim rnArea As Range
Dim rnCell As Range
Set rnArea = Range("D2" reccount)
For Each rnCell In rnArea
With rnCell
If Not IsError(.Value) Then
Select Case .Value
Case "Planning"
.Interior.ColorIndex = 45
Case "Engineers"
.Interior.ColorIndex = 20
End Select
End If
End With
Next
End Sub
Here is my current code, just need to know how to colour the row, not just
the cell and where to put it in my existing code (below)
---------------------
Private Sub Form_Load()
Dim delFile
On Error Resume Next
delFile = "c:\inventory.xls"
DoCmd.SetWarnings False
Kill delFile
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Inventory", "c:\inventory.xls", True
End Sub
---------------------
Private Sub ToExcel_Click()
Dim xl As Object
Set xl = CreateObject("Excel.Application")
Set xlwb = xl.Workbooks.Open("c:\Inventory.xls")
Set xlws = xlwb.Worksheets("Inventory")
xl.Visible = True
With xlws
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
.Cells.Select
.Cells.EntireColumn.AutoFit
Selection.AutoFilter
.Rows("1:1").Select
Selection.Font.Bold = True
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("A1").Select
xlwb.Application.ActiveWorkbook.Save
xl.Quit
Set xlws = Nothing
Set xlwb = Nothing
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
..To = "(e-mail address removed)"
..Subject = "Inventory"
..Attachments.Add ("c:\Inventory.xls")
..Send
End With
End Sub
from within Access
I export my data into an excel spreadsheet, autofilter and arranfge column
widths, then e-mail to an exchange folder, all from VBA
I now want to also colour code the rows depending on the value in one of the
columns.
1) Determine number of rows to be placed on excel (this should equate to
number of records + 1)
dim reccount
reccount = DCount("ID", "Inventory")
2) For correctness, discount row1 (this is a heading row)
Just start from D2
3) select range D2 to Dx (column D has required value)
use a loop D2 to reccount
4) could possibly use loop and case to determine value of cells
if Planning found in cell dx, colour the row in blue, if Engineers found,
colour red, or leave uncoloured if neither value found
e.g.
dim Counter
For Counter = 2 To reccount Step 1
If Not IsError(.Value) Then
Select Case .Value
Case "Planning"
.Interior.ColorIndex = 45
Case "Engineers"
.Interior.ColorIndex = 20
End Select
End If
Next Counter
or
Sub Check_Range_Value()
Dim rnArea As Range
Dim rnCell As Range
Set rnArea = Range("D2" reccount)
For Each rnCell In rnArea
With rnCell
If Not IsError(.Value) Then
Select Case .Value
Case "Planning"
.Interior.ColorIndex = 45
Case "Engineers"
.Interior.ColorIndex = 20
End Select
End If
End With
Next
End Sub
Here is my current code, just need to know how to colour the row, not just
the cell and where to put it in my existing code (below)
---------------------
Private Sub Form_Load()
Dim delFile
On Error Resume Next
delFile = "c:\inventory.xls"
DoCmd.SetWarnings False
Kill delFile
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"Inventory", "c:\inventory.xls", True
End Sub
---------------------
Private Sub ToExcel_Click()
Dim xl As Object
Set xl = CreateObject("Excel.Application")
Set xlwb = xl.Workbooks.Open("c:\Inventory.xls")
Set xlws = xlwb.Worksheets("Inventory")
xl.Visible = True
With xlws
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
.Cells.Select
.Cells.EntireColumn.AutoFit
Selection.AutoFilter
.Rows("1:1").Select
Selection.Font.Bold = True
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("A1").Select
xlwb.Application.ActiveWorkbook.Save
xl.Quit
Set xlws = Nothing
Set xlwb = Nothing
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
..To = "(e-mail address removed)"
..Subject = "Inventory"
..Attachments.Add ("c:\Inventory.xls")
..Send
End With
End Sub