' Excel-taulukon HTML-puristin
Sub TeeTaulukko()
Dim strData As String
Dim obj As DataObject
Dim td, tr, th, tdc, trc, thc As String
Dim nA, nR, nS, nSApu, nColspan As Long
Dim ots As Boolean
Set obj = New DataObject
td = "<td>"
tr = "<tr>"
th = "<th>"
tdc = "</td>"
trc = "</tr>"
thc = "</th>"
ots = False

If MsgBox("Näytetäänkö taulukossa reunukset?", vbYesNo, "Borderit") = vbYes Then
    strData = "<table border=""1"">"
Else
    strData = "<table>"
End If
For nA = 1 To Selection.Areas.Count
  For nR = 1 To Selection.Areas(nA).Rows.Count
    If nR = 1 Then
        If MsgBox("Onko ensimmäisellä rivillä otsikot?", vbYesNo, "Otsikot") = vbYes Then
            ots = True
        End If
    Else
        ots = False
    End If
    strData = strData & tr
    For nS = 1 To Selection.Areas(nA).Columns.Count
      If ots Then
        nColspan = 1
        If nS + 1 <= Selection.Areas(nA).Columns.Count Then
            For nSApu = nS + 1 To Selection.Areas(nA).Columns.Count
                If Selection.Areas(nA).Cells(nR, nSApu).Text = "" Then
                    nColspan = nColspan + 1
                Else
                    Exit For
                End If
            Next nSApu
        End If
        If nColspan > 1 And Not Selection.Areas(nA).Cells(nR, nS).Text = "" Then
            strData = strData & "<th colspan=""" & str(nColspan) & """>" & Selection.Areas(nA).Cells(nR, nS).Text & thc
        ElseIf Not Selection.Areas(nA).Cells(nR, nS).Text = "" Then
            strData = strData & th & Selection.Areas(nA).Cells(nR, nS).Text & thc
        End If
      Else
        strData = strData & td & Selection.Areas(nA).Cells(nR, nS).Text & tdc
      End If
    Next nS
    strData = strData & trc
  Next nR
Next nA

strData = strData & "</table>"
obj.SetText strData
obj.PutInClipboard
End Sub