TPE

http://bayanbox.ir/view/263405954590585756/2mobile.png

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub TableToHTML()    
    Dim oTable As Table
    Dim oSh As Shape
    Dim lColumn As Long
    Dim lRow As Long
    Dim sTableHTML As String

    ' No error checking here
    ' It's up to user to select a PowerPoint table before running this
    ' Note: POWERPOINT table, not pasted Word or Excel tables

    ' Start table off:
    sTableHTML = "<html>" & vbCrLf _
        & "<head>" & vbCrLf _
        & "</head>" & vbCrLf _
        & "<body>" & vbCrLf & vbCrLf _
        & "<table>" & vbCrLf

    Set oTable = ActiveWindow.Selection.ShapeRange(1).Table
    With oTable
        For lRow = 1 To .Rows.Count
            sTableHTML = sTableHTML & vbTab & "<tr>" & vbCrLf
            For lColumn = 1 To .Columns.Count
                sTableHTML = sTableHTML _
                    & vbTab & vbTab & "<td>" _
                    & .Cell(lRow, lColumn).Shape.TextFrame.TextRange.Text _
                    & "</td>" & vbCrLf
            Next
            sTableHTML = sTableHTML & vbTab & "</tr>" & vbCrLf
        Next
    End With

    ' finish up
    sTableHTML = sTableHTML & "</table>" & vbCrLf _
        & "</body>" & vbCrLf _
        & "</html>" & vbCrLf

    ' display the result in Immediate window
    ' Press Ctrl+G if you don't see the output
    Debug.Print sTableHTML

    ' Save to file
    Dim iFileNum As Integer
    iFileNum = FreeFile()
    Open "C:\Table.htm" For Output As #iFileNum
    Print #iFileNum, sTableHTML
    Close #iFileNum    
End Sub