'/* >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
 '/* Эксопрт данных из MSFlexGrid в MS Office 
Function ExportToOffice()
Dim frmPrint As New frmExportMSOff, oListItems As MSComctlLib.ListItems, oItem As MSComctlLib.ListItem
Dim i As Integer, j As Integer, intColumnCount As Integer, strColumn As String
Dim k As Integer, m As Integer
     ' заполняем ListView нименованиями колонок 
    Set oListItems = frmPrint.lvwColumns.ListItems
    Set oItem = oListItems.Add(, , "№ строки")
    oItem.Checked = False
    For i =  1  To GridSearch.Rows -  1 
        If GridSearch.TextMatrix(i,  8 ) = "1" Then
            Set oItem = oListItems.Add(, , GridBrowse.TextMatrix( 0 , i))
            oItem.Checked = True
            j = j +  1 
        End If
    Next i
    frmPrint.Frame1.Caption = "Таблица (" & Trim$(j) & " x " & Trim$(GridBrowse.Rows -  1 ) & ")"
    frmPrint.Show vbModal, Me
    If Len(frmPrint.Tag) >  0  Then    ' в форме frmExportMSOff нажали кнопку "OK" 
         ' определяем количство столбцов для экспорта 
        For i =  1  To oListItems.Count
            If oListItems(i).Checked Then intColumnCount = intColumnCount +  1 
        Next i
        Select Case CInt(GetSetting("OBU", "MS Office", "OfficeApp"))
            Case  0            ' экспорт в Word 
                 'создаём новый экземпляр Word-a и создаём новый документ в Word-e 
                Dim WordApp As New Word.Application, DocWord As Word.Document, TableWord As Word.Table
                Set DocWord = WordApp.Documents.Add
                
                 ' определяем ориентацию страницы 
                DocWord.PageSetup.Orientation = CInt(GetSetting("OBU", "MS Office", "PageFormat"))
                
                 'создаём таблицу во всю ширину области печати текста 
                Set TableWord = DocWord.Tables.Add(DocWord.Range(), GridBrowse.Rows, intColumnCount)
                
                 ' нумерация строк 
                If oListItems( 1 ).Checked Then
                    TableWord.Cell( 1 ,  1 ).Range.Text = "№ строки"
                    m =  2 
                    For i =  1  To GridBrowse.Rows -  1 
                        TableWord.Cell(i +  1 ,  1 ).Range.Text = Str$(i)
                    Next i
                Else
                    m =  1 
                End If
                
                 ' /* заполняем таблицу 
                 ' 1. документ - "справочник" или в QBE отмечены все поля на просмотр 
                If GridBrowse.Cols = GridSearch.Rows Then
                    j =  2 
                    For i =  1  To GridSearch.Rows -  1 
                        If GridSearch.TextMatrix(i,  8 ) = "1" Then
                            If oListItems(j).Checked Then
                                For k =  1  To GridBrowse.Rows -  1 
                                    TableWord.Cell(k +  1 , m).Range.Text = GridBrowse.TextMatrix(k, i)
                                Next k
                                m = m +  1 
                            End If
                            j = j +  1 
                        End If
                    Next i
                Else
                 ' 2. документ - QBE отмечены не все поля на просмотр 
                End If
                WordApp.Visible = True
                DocWord.Activate

                 'уничтожаем ссылки на обьект - документ Word, обьект - приложение Word 
                Set TableWord = Nothing
                Set DocWord = Nothing
                Set WordApp = Nothing

            Case  1            ' экспорт в Excel 
                 'создаём новый экземпляр Excel-a, документ в Excel-e 
                Dim ExcelApp As New Excel.Application, DocExcel As Excel.Workbook, SheetExcel As Excel.Worksheet
                
                Set DocExcel = ExcelApp.Workbooks.Add
                 ' определяем ориентацию страницы 
                Set SheetExcel = DocExcel.Worksheets( 1 )      ' Лист 1 
                SheetExcel.PageSetup.Orientation = CInt(GetSetting("OBU", "MS Office", "PageFormat")) +  1 
                
                ExcelApp.Visible = True
                DocExcel.Activate
                 'уничтожаем ссылки на обьект - документ Excel, обьект - приложение Excel 
                Set SheetExcel = Nothing
                Set DocExcel = Nothing
                Set ExcelApp = Nothing
                
        End Select
    End If
    Unload frmPrint
     'уничтожаем ссылку на обьект frmExportMSOff 
    Set frmPrint = Nothing
End Function