I got the following code to make a .html file from a sheet range and it
works fine.
Now trying to make the alternate rows a certain colour. How would I do that
with this
code?

Function fCreateHTMLTable(rngData As Range, _
blnUseHeaderTags As Boolean) As String
'================================================= ==================
'= Procedu fCreateHTMLTable =
'= Type: Private Function =
'= =
'= Purpose: Creates a 'clean' HTML table (ie. no unwanted =
'= formatting tags) from an Excel range. Understands =
'= merged cells. =
'= Parameters: rngData - Range - The range to be converted to =
'= HTML. blnUseHeaderTags - Boolean - True if column =
'= heads are to use <TH rather than <TD tags. =
'= Returns: String - The HTML string surrounded by <TABLE =
'= tags. =
'= =
'= Version: Date: Developer: Action: =
'=---------|---------|---------------|-----------------------------=
'= 1.0.0 |15-Nov-99| Rob Bruce | Created =
'================================================= ==================

'================================================= ==============
'HTML Tags
'Table
Const TABLE_BEGIN As String = "<TABLE"
Const TABLE_END As String = "</TABLE"

'Row
Const TABLE_ROW As String = "<TR"
Const TABLE_ROW_END As String = "</TR"

'Cells
Const TABLE_HEADER_BEGIN As String = "<TH"
Const TABLE_HEADER_END As String = "</TH"
Const TABLE_CELL_BEGIN As String = "<TD"
Const TABLE_CELL_END As String = "</TD"

'Attributes
Const TABLE_CELL_MERGEROWS As String = " ROWSPAN = """
Const TABLE_CELL_MERGECOLS As String = " COLSPAN = """

'Misc
Const DOUBLE_QUOTE As String = """"
Const TAG_CLOSE As String = ""
Const COMMENT_START As String = "<!--Exported From Excel: "
Const COMMENT_END As String = "--"
'================================================= ==============

Dim intColCount As Integer
Dim intRowCount As Integer
Dim intColCounter As Integer
Dim intRowCounter As Integer

Dim intMergeRowsCount As Integer
Dim intMergeColsCount As Integer

Dim rngCell As Range
Dim blnCommitCell As Boolean

Dim strHTML As String
Dim strAttributes As String

'Initial table tag...
strHTML = TABLE_BEGIN
'Comment - delete this line or comment it out
'if you don't want the HTML comment at the head
'of your table...
strHTML = strHTML & vbCrLf & COMMENT_START & _
rngData.Address(external:=True) & _
COMMENT_END

With rngData

'Discover dimensions of the data we
'will be dealing with...
intColCount = .Columns.count
intRowCount = .Rows.count

'Loop down the table's rows
For intRowCounter = 1 To intRowCount

'Make the HTML a little friendlier
strHTML = strHTML & vbCrLf & TABLE_ROW

'Loop accross columns...
For intColCounter = 1 To intColCount

'Mark the cell under current scrutiny by setting
'an object variable...
Set rngCell = .Cells(intRowCounter, intColCounter)

'(Re-) initialise variable that will hold
'the cell's internal attributes...
strAttributes = ""

'(Re-) initialise variable that will tell us
'whether this cell will be written to the table
'(it will not if it is part of a merged range
'and is not that range's first cell).
blnCommitCell = True

'Is the cell merged?..
If Not rngCell.MergeArea.Address = _
rngCell.Address Then

'Is the cell the first cell in the merged range?
'(we're only interested in it if it is)
If rngCell.Address = rngCell.MergeArea. _
Cells(1).Address Then

'How many columns in the merged range?..
intMergeColsCount = rngCell.MergeArea. _
Columns.count

'If there are more than one we need to
'register this in the Attributes string...
If Not intMergeColsCount = 1 Then
strAttributes = TABLE_CELL_MERGECOLS & _
intMergeColsCount & DOUBLE_QUOTE
End If

'Do the same sort of thing for rows in
'the merged range...
intMergeRowsCount = rngCell.MergeArea _
.Rows.count

If Not intMergeRowsCount = 1 Then
strAttributes = strAttributes & _
TABLE_CELL_MERGEROWS & _
intMergeRowsCount & DOUBLE_QUOTE
End If

Else
'Otherwise we don't want to do anything
'with this cell - it is irrelevant to
'HTML: Only the first (upper left) cell
'of an HTML merged range is actually
'coded into the table...
blnCommitCell = False
End If

End If

'OK, so now we need to construct the actual
'HTML tag for the cell - if the cell is to
'be coded, of course...
If blnCommitCell Then
'Use <TH table header tags for the top
'row of the table...
If intRowCounter = 1 And blnUseHeaderTags Then
strHTML = strHTML & TABLE_HEADER_BEGIN & _
strAttributes & TAG_CLOSE
Else
'Otherwise use regular <TD tags...
strHTML = strHTML & TABLE_CELL_BEGIN & _
strAttributes & TAG_CLOSE

End If

'Now we can enter the cell's actual value.
'We'll use the Text property of the cell
'so that the actual display of the cell is
'coded into the HTML table...
strHTML = strHTML & rngCell.Text

'Close off the tag by inserting the
'appropriate </TH or </TD tag end.
If intRowCounter = 1 And blnUseHeaderTags Then
strHTML = strHTML & TABLE_HEADER_END
Else
strHTML = strHTML & TABLE_CELL_END
End If
End If

Next
'Close off the row...
strHTML = strHTML & TABLE_ROW_END
Next
End With

'Finally, close off the table...
strHTML = strHTML & vbCrLf & TABLE_END

'Return the HTML string...
fCreateHTMLTable = strHTML

End Function


Thanks for any advice.

RBS

Forget this, I have worked this out.
Will need some better colours, but this is how it works:


Function fCreateHTMLTable(rngData As Range, _
blnUseHeaderTags As Boolean) As String
'================================================= ==================
'= Procedu fCreateHTMLTable =
'= Type: Private Function =
'= =
'= Purpose: Creates a 'clean' HTML table (ie. no unwanted =
'= formatting tags) from an Excel range. Understands =
'= merged cells. =
'= Parameters: rngData - Range - The range to be converted to =
'= HTML. blnUseHeaderTags - Boolean - True if column =
'= heads are to use <TH rather than <TD tags. =
'= Returns: String - The HTML string surrounded by <TABLE =
'= tags. =
'= =
'= Version: Date: Developer: Action: =
'=---------|---------|---------------|-----------------------------=
'= 1.0.0 |15-Nov-99| Rob Bruce | Created =
'================================================= ==================

'================================================= ==============
'HTML Tags
'Table
Const TABLE_BEGIN As String = "<TABLE"
Const TABLE_END As String = "</TABLE"

'Row
Const TABLE_ROW_FIELDS As String = "<TR bgcolor=#002244"
Const TABLE_ROW_ODDS As String = "<TR bgcolor=#665511"
Const TABLE_ROW As String = "<TR"
Const TABLE_ROW_END As String = "</TR"

'Cells
Const TABLE_HEADER_BEGIN As String = "<TH"
Const TABLE_HEADER_END As String = "</TH"
Const TABLE_CELL_BEGIN As String = "<TD"
Const TABLE_CELL_END As String = "</TD"

'Attributes
Const TABLE_CELL_MERGEROWS As String = " ROWSPAN = """
Const TABLE_CELL_MERGECOLS As String = " COLSPAN = """

'Misc
Const DOUBLE_QUOTE As String = """"
Const TAG_CLOSE As String = ""
Const COMMENT_START As String = "<!--Exported From Excel: "
Const COMMENT_END As String = "--"
'================================================= ==============

Dim intColCount As Integer
Dim intRowCount As Integer
Dim intColCounter As Integer
Dim intRowCounter As Integer

Dim intMergeRowsCount As Integer
Dim intMergeColsCount As Integer

Dim rngCell As Range
Dim blnCommitCell As Boolean

Dim strHTML As String
Dim strAttributes As String

'Initial table tag...
strHTML = TABLE_BEGIN
'Comment - delete this line or comment it out
'if you don't want the HTML comment at the head
'of your table...
strHTML = strHTML & vbCrLf & COMMENT_START & _
rngData.Address(external:=True) & _
COMMENT_END

With rngData

'Discover dimensions of the data we
'will be dealing with...
intColCount = .Columns.count
intRowCount = .Rows.count

'Loop down the table's rows
For intRowCounter = 1 To intRowCount

'Make the HTML a little friendlier
If intRowCounter = 1 Then
If blnUseHeaderTags = True Then
strHTML = strHTML & vbCrLf & TABLE_ROW_FIELDS
Else
strHTML = strHTML & vbCrLf & TABLE_ROW_ODDS
End If
Else
If Not intRowCounter Mod 2 = 0 Then
strHTML = strHTML & vbCrLf & TABLE_ROW_ODDS
Else
strHTML = strHTML & vbCrLf & TABLE_ROW
End If
End If

'Loop accross columns...
For intColCounter = 1 To intColCount

'Mark the cell under current scrutiny by setting
'an object variable...
Set rngCell = .Cells(intRowCounter, intColCounter)

'(Re-) initialise variable that will hold
'the cell's internal attributes...
strAttributes = ""

'(Re-) initialise variable that will tell us
'whether this cell will be written to the table
'(it will not if it is part of a merged range
'and is not that range's first cell).
blnCommitCell = True

'Is the cell merged?..
If Not rngCell.MergeArea.Address = _
rngCell.Address Then

'Is the cell the first cell in the merged range?
'(we're only interested in it if it is)
If rngCell.Address = rngCell.MergeArea. _
Cells(1).Address Then

'How many columns in the merged range?..
intMergeColsCount = rngCell.MergeArea. _
Columns.count

'If there are more than one we need to
'register this in the Attributes string...
If Not intMergeColsCount = 1 Then
strAttributes = TABLE_CELL_MERGECOLS & _
intMergeColsCount & DOUBLE_QUOTE
End If

'Do the same sort of thing for rows in
'the merged range...
intMergeRowsCount = rngCell.MergeArea _
.Rows.count

If Not intMergeRowsCount = 1 Then
strAttributes = strAttributes & _
TABLE_CELL_MERGEROWS & _
intMergeRowsCount & DOUBLE_QUOTE
End If

Else
'Otherwise we don't want to do anything
'with this cell - it is irrelevant to
'HTML: Only the first (upper left) cell
'of an HTML merged range is actually
'coded into the table...
blnCommitCell = False
End If

End If

'OK, so now we need to construct the actual
'HTML tag for the cell - if the cell is to
'be coded, of course...
If blnCommitCell Then
'Use <TH table header tags for the top
'row of the table...
If intRowCounter = 1 And blnUseHeaderTags Then
strHTML = strHTML & TABLE_HEADER_BEGIN & _
strAttributes & TAG_CLOSE
Else
'Otherwise use regular <TD tags...
strHTML = strHTML & TABLE_CELL_BEGIN & _
strAttributes & TAG_CLOSE

End If

'Now we can enter the cell's actual value.
'We'll use the Text property of the cell
'so that the actual display of the cell is
'coded into the HTML table...
strHTML = strHTML & rngCell.Text

'Close off the tag by inserting the
'appropriate </TH or </TD tag end.
If intRowCounter = 1 And blnUseHeaderTags Then
strHTML = strHTML & TABLE_HEADER_END
Else
strHTML = strHTML & TABLE_CELL_END
End If
End If

Next

'Close off the row...
strHTML = strHTML & TABLE_ROW_END
Next
End With

'Finally, close off the table...
strHTML = strHTML & vbCrLf & TABLE_END

'Return the HTML string...
fCreateHTMLTable = strHTML

End Function



RBS


"RB Smissaert" wrote in message
...
I got the following code to make a .html file from a sheet range and it
works fine.
Now trying to make the alternate rows a certain colour. How would I do
that with this
code?

Function fCreateHTMLTable(rngData As Range, _
blnUseHeaderTags As Boolean) As String
'================================================= ==================
'= Procedu fCreateHTMLTable =
'= Type: Private Function =
'= =
'= Purpose: Creates a 'clean' HTML table (ie. no unwanted =
'= formatting tags) from an Excel range. Understands =
'= merged cells. =
'= Parameters: rngData - Range - The range to be converted to =
'= HTML. blnUseHeaderTags - Boolean - True if column =
'= heads are to use <TH rather than <TD tags. =
'= Returns: String - The HTML string surrounded by <TABLE =
'= tags. =
'= =
'= Version: Date: Developer: Action: =
'=---------|---------|---------------|-----------------------------=
'= 1.0.0 |15-Nov-99| Rob Bruce | Created =
'================================================= ==================

'================================================= ==============
'HTML Tags
'Table
Const TABLE_BEGIN As String = "<TABLE"
Const TABLE_END As String = "</TABLE"

'Row
Const TABLE_ROW As String = "<TR"
Const TABLE_ROW_END As String = "</TR"

'Cells
Const TABLE_HEADER_BEGIN As String = "<TH"
Const TABLE_HEADER_END As String = "</TH"
Const TABLE_CELL_BEGIN As String = "<TD"
Const TABLE_CELL_END As String = "</TD"

'Attributes
Const TABLE_CELL_MERGEROWS As String = " ROWSPAN = """
Const TABLE_CELL_MERGECOLS As String = " COLSPAN = """

'Misc
Const DOUBLE_QUOTE As String = """"
Const TAG_CLOSE As String = ""
Const COMMENT_START As String = "<!--Exported From Excel: "
Const COMMENT_END As String = "--"
'================================================= ==============

Dim intColCount As Integer
Dim intRowCount As Integer
Dim intColCounter As Integer
Dim intRowCounter As Integer

Dim intMergeRowsCount As Integer
Dim intMergeColsCount As Integer

Dim rngCell As Range
Dim blnCommitCell As Boolean

Dim strHTML As String
Dim strAttributes As String

'Initial table tag...
strHTML = TABLE_BEGIN
'Comment - delete this line or comment it out
'if you don't want the HTML comment at the head
'of your table...
strHTML = strHTML & vbCrLf & COMMENT_START & _
rngData.Address(external:=True) & _
COMMENT_END

With rngData

'Discover dimensions of the data we
'will be dealing with...
intColCount = .Columns.count
intRowCount = .Rows.count

'Loop down the table's rows
For intRowCounter = 1 To intRowCount

'Make the HTML a little friendlier
strHTML = strHTML & vbCrLf & TABLE_ROW

'Loop accross columns...
For intColCounter = 1 To intColCount

'Mark the cell under current scrutiny by setting
'an object variable...
Set rngCell = .Cells(intRowCounter, intColCounter)

'(Re-) initialise variable that will hold
'the cell's internal attributes...
strAttributes = ""

'(Re-) initialise variable that will tell us
'whether this cell will be written to the table
'(it will not if it is part of a merged range
'and is not that range's first cell).
blnCommitCell = True

'Is the cell merged?..
If Not rngCell.MergeArea.Address = _
rngCell.Address Then

'Is the cell the first cell in the merged range?
'(we're only interested in it if it is)
If rngCell.Address = rngCell.MergeArea. _
Cells(1).Address Then

'How many columns in the merged range?..
intMergeColsCount = rngCell.MergeArea. _
Columns.count

'If there are more than one we need to
'register this in the Attributes string...
If Not intMergeColsCount = 1 Then
strAttributes = TABLE_CELL_MERGECOLS & _
intMergeColsCount &
DOUBLE_QUOTE
End If

'Do the same sort of thing for rows in
'the merged range...
intMergeRowsCount = rngCell.MergeArea _
.Rows.count

If Not intMergeRowsCount = 1 Then
strAttributes = strAttributes & _
TABLE_CELL_MERGEROWS & _
intMergeRowsCount &
DOUBLE_QUOTE
End If

Else
'Otherwise we don't want to do anything
'with this cell - it is irrelevant to
'HTML: Only the first (upper left) cell
'of an HTML merged range is actually
'coded into the table...
blnCommitCell = False
End If

End If

'OK, so now we need to construct the actual
'HTML tag for the cell - if the cell is to
'be coded, of course...
If blnCommitCell Then
'Use <TH table header tags for the top
'row of the table...
If intRowCounter = 1 And blnUseHeaderTags Then
strHTML = strHTML & TABLE_HEADER_BEGIN & _
strAttributes & TAG_CLOSE
Else
'Otherwise use regular <TD tags...
strHTML = strHTML & TABLE_CELL_BEGIN & _
strAttributes & TAG_CLOSE

End If

'Now we can enter the cell's actual value.
'We'll use the Text property of the cell
'so that the actual display of the cell is
'coded into the HTML table...
strHTML = strHTML & rngCell.Text

'Close off the tag by inserting the
'appropriate </TH or </TD tag end.
If intRowCounter = 1 And blnUseHeaderTags Then
strHTML = strHTML & TABLE_HEADER_END
Else
strHTML = strHTML & TABLE_CELL_END
End If
End If

Next
'Close off the row...
strHTML = strHTML & TABLE_ROW_END
Next
End With

'Finally, close off the table...
strHTML = strHTML & vbCrLf & TABLE_END

'Return the HTML string...
fCreateHTMLTable = strHTML

End Function


Thanks for any advice.

RBS