Thrakrath

Hi

I've made a small program that opens an excel spreadsheet and converts the data into html table. The only problem is that I can't seem to detect if cells are merged. How is that possible?

I’ve included the code that converts the spreadsheet to html:

Private Sub Command1_Click()
Dim aObjExcel As New Excel.Application
Dim aObjWorkSheet As Excel.Worksheet
Dim aLngColCount As Long
Dim aLngRowCount As Long
Dim aLngCol As Long
Dim aLngRow As Long
Dim aStrHtml As String

aObjExcel.Workbooks.Open "c:\spreadsheet.xls"

With aObjExcel.ActiveWorkbook
For Each aObjWorkSheet In .Worksheets
aIntColCount = aObjWorkSheet.UsedRange.Columns.Count
aIntRowCount = aObjWorkSheet.UsedRange.Rows.Count

aStrHtml = aStrHtml & "<table border=1>" & _
"<tr>" & _
"<td colspan=" & aIntColCount & ">" & aObjWorkSheet.Name & "</td>" & _
"</tr>"

For aLngRow = 1 To aIntRowCount
aStrHtml = aStrHtml & "<tr>"

For aLngCol = 1 To aIntColCount
If aObjCol.aObjWorkSheet.Cells(aLngRow, aLngCol).MergeCells = True Then
End If
aStrHtml = aStrHtml & "<td>" & aObjCol.aObjWorkSheet.Cells(aLngRow, aLngCol).Value & "&nbsp;</td>"
Next aLngCol

aStrHtml = aStrHtml & "</tr>"
Next aLngRow

aStrHtml = aStrHtml & "</table>"
Next aObjWorkSheet
End With

aObjExcel.Quit
Set aObjExcel = Nothing

MsgBox aStrHtml
End Sub

Rory

Right, this looks like a bit of a nightmare!
The MergeCells property of a range defines whether the range contains cells that are part of merged cell(s). If this is the case, the Address property of the range will be different to the range you supplied to the constructor. From this you can deduce where merged cells occur (and where to omit). For example if Range("c4").MergeCells evaluated to true, it would mean that cell c4 is part of a merged cell.
As your code loops through systematically, you know that the first cell encountered with this property is the top of the merged area. (you would think top left, but as of excel 2000 it's been possible to make annoying star-shaped merged cells etc that are a nightmare to render in HTML).
You'd then need to check all cells below left, below middle, below right of the cell. If the MergeCells property evaluates to true, then repeat (wahey recursion!). The only implication is converting to HTML: besides the problems of getting it to line up properly, simply outputting all the <TD colspan="x">s in the right place will be difficult:

I would suggest using an array, loading information to it as you pass through the spreadsheet and then outputting the HTML, rather than doing it in one step.

Respect to you if you go ahead with it!

Alternatively you could deny all knowledge of merged cells with an error message: when you're getting this complex you might as well use the default Excel export as HTML methods (which you can get at through VB).

Hope this helps!

Thrakrath

I've managed to come with something that can manage merge cells. Thanks for your help :-)

The following code should do the trick :-)

Dim aObjExcel As Object
Dim aObjWorkSheet As Object
Dim aObjRange As Object
Dim aLngColCount As Long
Dim aLngRowCount As Long
Dim aLngCol As Long
Dim aLngRow As Long
Dim aLngColSpan As Long
Dim aLngRowSpan As Long
Dim aStrHtml As String
Dim aStrColSpan As String
Dim aStrRowSpan As String
Dim aBoolMerge As Boolean

On Error GoTo Error_Handler

Set aObjExcel = CreateObject("Excel.Application")

aObjExcel.DisplayAlerts = False

aObjExcel.Workbooks.Open xObjCls.File

With aObjExcel.ActiveWorkbook
For Each aObjWorkSheet In .Worksheets
With aObjWorkSheet
aLngColCount = .UsedRange.Columns.Count
aLngRowCount = .UsedRange.Rows.Count

aStrHtml = aStrHtml & "<table border=1>" & vbCrLf & _
vbTab & "<tr>" & vbCrLf & _
vbTab & vbTab & "<td colspan=" & aLngColCount & ">" & .Name & "</td>" & vbCrLf & _
vbTab & "</tr>" & vbCrLf

For aLngRow = 1 To aLngRowCount
aStrHtml = aStrHtml & vbTab & "<tr>" & vbCrLf

For aLngCol = 1 To aLngColCount
If aLngRow > 1 Then
Set aObjRange = .Cells.Range(.Cells(aLngRow, aLngCol).Address)

If Not aObjExcel.Intersect(aObjRange.MergeArea, aObjRange.Offset(-1, 0)) Is Nothing Then
aBoolMerge = True
Else
aBoolMerge = False
End If
End If

If aBoolMerge = False Then
Call sRange(.Cells, 1, aLngRow, aLngCol, aLngRowSpan)

If aLngRowSpan > 1 Then
aStrRowSpan = " rowspan=" & aLngRowSpan
End If

Call sRange(.Cells, 2, aLngRow, aLngCol, aLngColSpan)

If aLngColSpan > 1 Then
aStrColSpan = " colspan=" & aLngColSpan
End If

aStrHtml = aStrHtml & vbTab & vbTab & "<td" & aStrRowSpan & aStrColSpan & ">&nbsp;" & .Cells(aLngRow, aLngCol) & "&nbsp;</td>" & vbCrLf

If aLngColSpan > 1 Then
aLngCol = aLngCol + aLngColSpan - 1
End If

aLngRowSpan = 1
aLngColSpan = 1
aStrColSpan = ""
aStrRowSpan = ""
End If
Next aLngCol

aStrHtml = aStrHtml & vbTab & "</tr>" & vbCrLf
Next aLngRow

aStrHtml = aStrHtml & "</table>" & vbCrLf & vbCrLf

If xObjCls.Name = "clsWrite" Then
If xObjCls.Merge = False Then
Call sPrint(xObjCls.Save, .Name & ".html", aStrHtml)
aStrHtml = ""
End If
End If
End With
Next aObjWorkSheet
End With

If xObjCls.Name = "clsWrite" Then
If xObjCls.Merge = True Then
Call sPrint(xObjCls.Save, aObjExcel.Name & ".html", aStrHtml)
End If
End If

If xObjCls.Name = "clsOpen" Then
xObjCls.Html = xObjCls.Html & aStrHtml
End If

Error_Handler:
aObjExcel.Quit

Set aObjExcel = Nothing
Set aObjWorkSheet = Nothing
Set aObjRange = Nothing

If Err.Number <> 0 Then
xObjCls.Error = Err.Source & vbCrLf & Err.Description
End If

Thrakrath

And ofcourse the sRange routine:

Private Sub sRange(ByRef xObjCell As Object, ByVal xIntType As Integer, ByVal xLngRow As Long, ByVal xLngCol As Long, ByRef xLngRange As Long)
Dim aLngRow As Long
Dim aLngCol As Long

aLngRow = xLngRow
aLngCol = xLngCol

If xLngRange = 0 Then
xLngRange = 1
End If

Select Case xIntType
Case 1 'Row
aLngRow = xLngRow + xLngRange
Case 2 'Col
aLngCol = xLngCol + xLngRange
End Select

If xObjCell.Range(xObjCell(xLngRow, xLngCol), xObjCell(aLngRow, aLngCol)).MergeCells = True Then
xLngRange = xLngRange + 1
Call sRange(xObjCell, xIntType, xLngRow, xLngCol, xLngRange)
End If
End Sub

Rory

OK cool!
Just out of interest, what are you using the code in?