Attribute VB_Name = "WordTables_to_Ventura"
Sub WordTables_to_Ventura()
'
' Word-2000  
'   12.05.2008, V. Rodin
'    Word-   Ventura-
'      .,    .    
    '(  ,     !)
' E -     ()  
    '    -   
'          
    '   (   )
'       
    '    ,   Venture 
'           
'          

Dim iTable, iRows, iCells, iCel, iColumns, iGamma, EEE, DocName, Doc_Temp, iText
Dim nTab, nCol, nRow, nRow_Cel, d, c, r, n, iColspan, iRowspan, i, j  As Integer, iArray()

'    Selection.TypeText Text:="@Z_STYLE70 = " & Chr(13)
    DocName = Selection.Document.Name
    Doc_Temp = "Temp_Table.doc"
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0 '<---   
    ActiveDocument.SaveAs FileName:="Temp_Table.doc"
    Documents.Open FileName:="Temp_Table.doc"
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0 '<---  2-  
    ActiveDocument.SaveAs FileName:="Temp_Cell.doc"
    Documents.Open FileName:="Temp_Cell.doc"
    Windows(DocName).Activate
    For Each iTable In ActiveDocument.Tables  '<---  . .  
        nCol = iTable.Columns.Count '<---    
        nRow = iTable.Rows.Count     '<---    
        ReDim iArray(nRow, nCol - 1) '<---   
        nRow_Cel = nRow * nCol       '<---       (  )
        iTable.Select
        EEE = String(nCol, "E")        '<---    
        EEE = Replace(EEE, "E", "E1, ")
        EEE = "(" & EEE & ")"
        EEE = Replace(EEE, "E1, )", "E1)")
        iGamma = "@Starttab = " & Chr(13) & "@Z_TBL_BEG = VERSION(8), COLUMNS(" & nCol & "), DIMENSION(TM), COLWIDTHS" & EEE & ", BOX(Single), HGRID(Single), VGRID(Single), ABOVE(8000), HGUTTER(7061), VGUTTER(3530), KEEP(OFF),"
        iArray(0, 0) = iGamma '<---        
        
'<---             ,      
        If (nRow * nCol) <> Selection.Cells.Count Then GoTo Split_Row_Cel
        
'<---    
        For Each iRows In iTable.Rows  '<---  . .    . 
            
            For Each iCells In iRows.Cells  '<---  . .    . 
                iCells.Select
                iGamma = Selection.Text
                iGamma = (Replace(iGamma, Right(iGamma, 2), "")) ' <---      
                
                iGamma = "@Z_TBL_CELL_BEG = " & Chr(13) & iGamma & Chr(13) & "@Z_TBL_CELL_END = "
                If iCells.ColumnIndex = 1 Then iGamma = "@Z_TBL_ROW_BEG = " & Chr(13) & iGamma
                If iCells.ColumnIndex = nCol Then iGamma = iGamma & Chr(13) & "@Z_TBL_ROW_END = "
                
                iArray(iCells.RowIndex, iCells.ColumnIndex - 1) = iGamma '<---    
            
            Next iCells '<---  
        Next iRows '<---  
    GoTo EndRow '<---  ,    Ventura-
                                            
            '<---      --->
Split_Row_Cel:
    iTable.Select
    Selection.Copy
    Windows(Doc_Temp).Activate
    Selection.Paste
    Selection.MoveUp Unit:=wdLine, Count:=1
    
    Selection.Tables(1).Select
    With Selection.Font
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .Color = wdColorAutomatic
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Animation = wdAnimationNone
    End With
    With Selection.ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .Alignment = wdAlignParagraphLeft
        .WidowControl = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = CentimetersToPoints(0)
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
    End With
    Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
    ActiveDocument.Background.Fill.Visible = msoFalse
    
    Selection.Tables(1).Select
    Selection.Style = ActiveDocument.Styles("")
    
    ActiveDocument.SaveAs FileName:="Temp_Table.htm", FileFormat:=wdFormatHTML
    ActiveDocument.Close (RouteDocument)
    Documents.Open FileName:=Doc_Temp
    Documents.Open FileName:="Temp_Table.htm", ConfirmConversions:=True, ReadOnly:= _
        False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
        "", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
        Format:=wdOpenFormatUnicodeText, Encoding:=msoEncodingCyrillic

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<html*\<tr*\>"
        .Replacement.Text = "<tr>"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<td width* "
        .Replacement.Text = "<td "
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " valign*'\>"
        .Replacement.Text = ">"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<span*'\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<p class*\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<\/span\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<\/p\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<\/table\>*\<\/html\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<\!\[if*if\]\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<o:p\>\<\/o:p\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "&nbsp;"
        .Replacement.Text = "<|>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'<---    
    GoSub Col_Numb '<---     
    nCol = a
    ReDim iArray(nRow, nCol - 1)
        EEE = String(nCol, "E")
        EEE = Replace(EEE, "E", "E1, ")
        EEE = "(" & EEE & ")"
        EEE = Replace(EEE, "E1, )", "E1)")
        iGamma = "@Starttab = " & Chr(13) & "@Z_TBL_BEG = VERSION(8), COLUMNS(" & nCol & "), DIMENSION(TM), COLWIDTHS" & EEE & ", BOX(Single), HGRID(Single), VGRID(Single), ABOVE(8000), HGUTTER(7061), VGUTTER(3530), KEEP(OFF),"
        iArray(0, 0) = iGamma
        
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "\<tr\>*\<\/tr\>"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
    End With
        Selection.Find.Execute
    
    i = 1
    Do While Selection.Find.Found = True
        Selection.Select
        Selection.Copy
        Windows("Temp_Table.doc").Activate
        Selection.Paste
        
        Selection.HomeKey Unit:=wdStory
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "\<td*\<\/td\>"
            .Replacement.Text = "^&"
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
        End With
        Selection.Find.Execute
        
        j = 0
        Do While Selection.Find.Found = True
                Selection.Select
                Selection.Copy
                Windows("Temp_Cell.doc").Activate
                Selection.Paste
                iColspan = 0
                iRowspan = 0
                r = 0
                
                Selection.HomeKey Unit:=wdStory
                Selection.Find.ClearFormatting
                With Selection.Find
                    .Text = "colspan=* r"
                    .Replacement.Text = "^&"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchWildcards = True
                End With
                Selection.Find.Execute
                If Selection.Find.Found = True _
                    Then
                    iText = Selection.Text
                    iText = Replace(iText, Left(iText, 8), "")
                    iText = Replace(iText, Right(iText, 2), "")
                    iColspan = iText
                    r = iColspan
                End If
                
                Selection.HomeKey Unit:=wdStory
                Selection.Find.ClearFormatting
                With Selection.Find
                    .Text = "colspan=*\>"
                    .Replacement.Text = "^&"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchWildcards = True
                End With
                Selection.Find.Execute
                If Selection.Find.Found = True _
                    Then
                    iText = Selection.Text
                        If Len(iText) > 12 _
                            Then
                                iColspan = r
                            Else:
                                iText = Replace(iText, Left(iText, 8), "")
                                iText = Replace(iText, Right(iText, 1), "")
                                iColspan = iText
                        End If
                End If
                
                Selection.HomeKey Unit:=wdStory
                Selection.Find.ClearFormatting
                With Selection.Find
                    .Text = "rowspan=*\>"
                    .Replacement.Text = "^&"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchWildcards = True
                End With
                Selection.Find.Execute
                If Selection.Find.Found = True _
                    Then
                    iText = Selection.Text
                    iText = Replace(iText, Left(iText, 8), "")
                    iText = Replace(iText, Right(iText, 1), "")
                    iRowspan = iText
                End If
                
                Selection.Find.ClearFormatting
                Selection.Find.Replacement.ClearFormatting
                With Selection.Find
                    .Text = "\<td\>"
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .MatchWildcards = True
                End With
                Selection.Find.Execute Replace:=wdReplaceAll
                
                Selection.HomeKey Unit:=wdStory
                Selection.Find.ClearFormatting
                Selection.Find.Replacement.ClearFormatting
                With Selection.Find
                    .Text = "\<td*\>"
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .MatchWildcards = True
                End With
                Selection.Find.Execute Replace:=wdReplaceAll
                
                Selection.Find.ClearFormatting
                Selection.Find.Replacement.ClearFormatting
                With Selection.Find
                    .Text = "\<\/td\>"
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindContinue
                    .MatchWildcards = True
                End With
                Selection.Find.Execute Replace:=wdReplaceAll
                
                Selection.Find.ClearFormatting '<--     -->  
                Selection.Find.Replacement.ClearFormatting
                With Selection.Find
                    .Text = "^0032{2;}"
                    .Replacement.Text = " "
                    .Forward = True
                    .Wrap = wdFindContinue
                    .MatchWildcards = True
                End With
                Selection.Find.Execute Replace:=wdReplaceAll

                Selection.HomeKey Unit:=wdStory
                Selection.Find.ClearFormatting
                Selection.Find.Replacement.ClearFormatting
                With Selection.Find
                    .Text = "^p "
                    .Replacement.Text = "^p"
                    .Forward = True
                    .Wrap = wdFindContinue
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                Selection.Find.Execute Replace:=wdReplaceAll
                
                Selection.HomeKey Unit:=wdStory
                Selection.EndKey Unit:=wdLine, Extend:=wdExtend
                Selection.Delete
                Selection.WholeStory
                iGamma = Selection.Text
                iGamma = (Replace(iGamma, Right(iGamma, 2), ""))
                
                iGamma = "@Z_TBL_CELL_BEG = " & Chr(13) & iGamma & Chr(13) & "@Z_TBL_CELL_END = "
                
                Do While Left(iArray(i, j), 1) = "@"        '<---         
                    j = j + 1
                    If j > nCol - 1 Then Exit Do
                Loop
                
                If j = 0 Then iGamma = "@Z_TBL_ROW_BEG = " & Chr(13) & iGamma
                If j = nCol - 1 Then iGamma = iGamma & Chr(13) & "@Z_TBL_ROW_END = "
                iArray(i, j) = iGamma
                
                If iColspan > 1 And iRowspan < 1 _
                    Then
                        GoSub ColSplit
                        GoTo EndCel
                End If
                If iRowspan > 1 Then GoSub RowSplit
EndCel:
                j = j + 1
                Selection.WholeStory
                Selection.Delete
                Windows("Temp_Table.doc").Activate
                
                Selection.Find.ClearFormatting
                With Selection.Find
                    .Text = "\<td*\<\/td\>"
                    .Replacement.Text = "^&"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchWildcards = True
                End With
                Selection.Find.Execute
            Loop
            
        Selection.WholeStory
        Selection.Delete
        j = 0
        i = i + 1
        Windows("Temp_Table.htm").Activate
            
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "\<tr\>*\<\/tr\>"
            .Replacement.Text = "^&"
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
        End With
        Selection.Find.Execute
    Loop
    
    
EndRow:
                '<---  Word- Ventura-    --->
        Windows(DocName).Activate
        iTable.Select
        iTable.Delete
        d = 1
        Selection.TypeText Text:=iArray(0, 0) & Chr(13)
        Do While d <= nRow
            For c = 0 To nCol - 1
                Selection.TypeText Text:=iArray(d, c) & Chr(13)
            Next
        d = d + 1
        Loop
        Selection.TypeText Text:="@Z_TBL_END = " & Chr(13) & "@Endtab = " & Chr(13)

EndTab:
        Erase iArray()
        
    Next iTable '<---  
        
    Windows("Temp_Table.doc").Close (RouteDocument)
    Windows("Temp_Cell.doc").Close (RouteDocument)
    GoTo End_Sub

ColSplit:
        q = iColspan
        n = 1
        Do While q > 1
            If j + n = nCol - 1 _
                Then
                    iArray(i, j + n) = "@Z_TBL_CELL_BEG = HJOINED" & Chr(13) & Chr(13) & "@Z_TBL_CELL_END = " & Chr(13) & "@Z_TBL_ROW_END = "
                Else:
                    iArray(i, j + n) = "@Z_TBL_CELL_BEG = HJOINED" & Chr(13) & Chr(13) & "@Z_TBL_CELL_END = "
            End If
            n = n + 1
            q = q - 1
        Loop
    '    j = j + n - 1
Return
    
    
RowSplit:
                        '<---      .  .   
        d = iRowspan
        a = 1
        Do While d > 1
            If j = 0 _
                Then
                    iArray(i + a, j) = "@Z_TBL_ROW_BEG = " & Chr(13) & "@Z_TBL_CELL_BEG = VJOINED" & Chr(13) & "@Z_TBL_CELL_END = "
            End If
            If j = nCol - 1 _
                Then
                    iArray(i + a, j) = "@Z_TBL_CELL_BEG = VJOINED" & Chr(13) & "@Z_TBL_CELL_END = " & Chr(13) & "@Z_TBL_ROW_END = "
            End If
            If j > 0 And j < nCol - 1 _
                Then
                    iArray(i + a, j) = "@Z_TBL_CELL_BEG = VJOINED" & Chr(13) & "@Z_TBL_CELL_END = "
            End If
            a = a + 1
            d = d - 1
        Loop
    
                    '<---      .  .   .   
        d = iRowspan
        q = iColspan
        If iColspan > 1 _
            Then
                n = 1
                Do While q > 1
                    If j + n = nCol - 1 _
                        Then
                            iArray(i, j + n) = "@Z_TBL_CELL_BEG = HJOINED" & Chr(13) & "@Z_TBL_CELL_END = " & Chr(13) & "@Z_TBL_ROW_END = "
                        Else:
                            iArray(i, j + n) = "@Z_TBL_CELL_BEG = HJOINED" & Chr(13) & "@Z_TBL_CELL_END = "
                    End If
                    n = n + 1
                    q = q - 1
                Loop
                
                a = 1
                Do While d > 1
                    q = iColspan
                    n = 1
                    Do While q > 1
                        If j + n = nCol - 1 _
                            Then
                                iArray(i + a, j + n) = "@Z_TBL_CELL_BEG = HJOINED" & Chr(13) & "@Z_TBL_CELL_END = " & Chr(13) & "@Z_TBL_ROW_END = "
                            Else:
                                iArray(i + a, j + n) = "@Z_TBL_CELL_BEG = HJOINED" & Chr(13) & "@Z_TBL_CELL_END = "
                        End If
                        n = n + 1
                        q = q - 1
                    Loop
                    a = a + 1
                    d = d - 1
                Loop
          '      j = j + n - 1
            End If
    Return

Col_Numb:
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "\<tr\>*\<\/tr\>"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
    End With
        Selection.Find.Execute
        Selection.Select
        
        d = 0
        Selection.Copy
        Windows("Temp_Table.doc").Activate
        Selection.Paste
        
        Selection.HomeKey Unit:=wdStory
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "\<td*\<\/td\>"
            .Replacement.Text = "^&"
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
        End With
        Selection.Find.Execute
        
        n = 0
        c = 0
    Do While Selection.Find.Found = True
        n = n + 1
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "\<td*\<\/td\>"
            .Replacement.Text = "^&"
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
        End With
        Selection.Find.Execute
    Loop
    
        Selection.HomeKey Unit:=wdStory
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = "\<td*\<\/td\>"
            .Replacement.Text = "^&"
            .Forward = True
            .Wrap = wdFindStop
            .MatchWildcards = True
        End With
        Selection.Find.Execute
        
        Do While Selection.Find.Found = True
                Selection.Select
                Selection.Copy
                Windows("Temp_Cell.doc").Activate
                Selection.Paste
                iColspan = 0
                iRowspan = 0
                r = 0
                
                Selection.HomeKey Unit:=wdStory
                Selection.Find.ClearFormatting
                With Selection.Find
                    .Text = "colspan=* r"
                    .Replacement.Text = "^&"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchWildcards = True
                End With
                Selection.Find.Execute
                If Selection.Find.Found = True _
                    Then
                    iText = Selection.Text
                    iText = Replace(iText, Left(iText, 8), "")
                    iText = Replace(iText, Right(iText, 2), "")
                    iColspan = iText
                    r = r + iColspan
                    c = c + 1
                End If
                
                Selection.HomeKey Unit:=wdStory
                Selection.Find.ClearFormatting
                With Selection.Find
                    .Text = "colspan=*\>"
                    .Replacement.Text = "^&"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchWildcards = True
                End With
                Selection.Find.Execute
                If Selection.Find.Found = True _
                    Then
                    iText = Selection.Text
                        If Len(iText) > 12 _
                            Then
                                iColspan = r
                            Else:
                                iText = Replace(iText, Left(iText, 8), "")
                                iText = Replace(iText, Right(iText, 1), "")
                                iColspan = iText
                                r = r + iColspan
                                c = c + 1
                        End If
          '      c = c + 1
                End If
        d = d + r
                Selection.WholeStory
                Selection.Delete
                Windows("Temp_Table.doc").Activate
                
                Selection.Find.ClearFormatting
                With Selection.Find
                    .Text = "\<td*\<\/td\>"
                    .Replacement.Text = "^&"
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchWildcards = True
                End With
                Selection.Find.Execute
            Loop
        a = n + d - c
        
        Selection.WholeStory
        Selection.Delete
        Windows("Temp_Table.htm").Activate
        Selection.HomeKey Unit:=wdStory
Return

End_Sub:
End Sub


