Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 |

 

  Вопрос: Работа с word. Добавлено: 29.07.06 22:56  

Автор вопроса:  KVU
В общем, создаю таблицу на основе ListView
Код:
--------------------------------------------
Dim WordApp As Word.Application
Dim DocWord As Word.Document
Dim TableWord As Word.Table

    Dim iColumn As Integer
    Dim iRow As Integer
    iColumn = lvwReport.ColumnHeaders.Count ' Кол-во колонок
    iRow = lvwReport.ListItems.Count + 1 ' Кол-во строк ListView + заголовок

    Set WordApp = New Word.Application
    WordApp.Visible = True
    Set DocWord = WordApp.Documents.Add
    DocWord.Activate

    If Check1.Value = 1 Then
        DocWord.PageSetup.Orientation = wdOrientPortrait
    Else
        DocWord.PageSetup.Orientation = wdOrientLandscape
    End If
   
    
    DocWord.Application.Selection.InsertAfter Chr(171) & "RNet" & Chr(187) & " - компьютерная сеть"
    DocWord.Application.Selection.EndOf
    DocWord.Application.Selection.InsertParagraphAfter
    DocWord.Application.Selection.InsertAfter "Краткий отчёт за выполненные работы c: " & DTPicker1.Value & " по: " & DTPicker2.Value
    DocWord.Application.Selection.EndOf
    DocWord.Application.Selection.InsertParagraphAfter
    DocWord.Application.Selection.InsertParagraphAfter

    ' Создаём таблицу
    Set TableWord = DocWord.Tables.Add(DocWord.Application.Selection.Range, iRow, iColumn)
    TableWord.Application.Selection.SplitTable
        
    ' Заполняем папку таблицы
    For i = 1 To iColumn
        TableWord.Cell(1, i).Range.Text = lvwReport.ColumnHeaders(i).Text
    Next i
       
    For i = 2 To iRow
        ' Заполняем вторую строку и первый столбец, Вторую потому что 1 это заголовок таблицы
        TableWord.Cell(i, 1).Range.Text = lvwReport.ListItems(i - 1).Text
        For i2 = 2 To iColumn
            ' Заполняем вторую строчку и последующие столбцы
            TableWord.Cell(i, i2).Range.Text = lvwReport.ListItems(i - 1).SubItems(i2 - 1)
        Next i2
    Next i
    
    
    ' заголовок таблицы закрашиваем ячейки шрифт делаем жырный
    ' выравниваем текст по высоте
    For i = 1 To iColumn
        TableWord.Cell(1, i).VerticalAlignment = wdCellAlignVerticalCenter
        TableWord.Cell(1, i).Shading.Texture = wdTextureNone
        TableWord.Cell(1, i).Shading.BackgroundPatternColor = wdColorPaleBlue
        TableWord.Cell(1, i).Range.Bold = True
    Next i
    
    ' Выделяем таблицу
    TableWord.Application.ActiveDocument.Select
    'TableWord.Select
    'TableWord.AllowAutoFit = True
    
    ' Таблицу выравниваем по центу листа
    With TableWord.Application.Selection.Tables(1)
        .Rows.Alignment = wdAlignRowCenter
    End With
    
    ' Автоподбор ячеек по содержимому
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
    
    ' Автоподбор ячеек по ширине окна
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    
    ' Снимаем выдиление
    TableWord.Application.Selection.EndOf
--------------------------------------------

Проблема заключается в том что:
1. При формирования отчёта если не закрывать Word тогда на принимаются свойства ' Автоподбор ячеек по содержимому
 Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
2. Если закрыть Word и повторно формировать отчёт то появляется ошибка:
Run-Time error 462
The remote server machine does not exist or is unavailable
Т.е. отчёт формируется один раз, если полностью закрыть программу и запустишь то он опять сформируется один раз и всё, последующие попытки сформировать отчёт заканчиваются либо ошибкой, либо не форматирует как надо. Да если если запущен совсем другой Word то при попытки сформировать выдаётся ошибка
Run-Time error 5941
Запрашиваемый номер свойства не определен (это Tables(1)) .
Подскажите, пожалуйста, что этот Word так глючит?
С уважением, Владислав.

Ответить

  Ответы Всего ответов: 18  

Номер ответа: 1
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
  Профиль | | #1 Добавлено: 29.07.06 23:08
Подскажите, пожалуйста, что этот Word так глючит?
Я тебе могу со 100% уверенностью сказать - это не Word глючит, а руки у программера... Попробуй загружать и выгружать объект нормально, тогда и глюки куда-то пропадут... :)

Ответить

Номер ответа: 2
Автор ответа:
 KVU



Вопросов: 10
Ответов: 32
  Профиль | | #2 Добавлено: 30.07.06 02:05
Попробуй загружать и выгружать объект нормально


Расскажи и будем загружать
С уважением, Владислав.

Ответить

Номер ответа: 3
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
  Профиль | | #3 Добавлено: 30.07.06 14:23
Ну лан. В этой процедуре ты создаёшь экземпляр объекта Word. Но я не вижу код, где ты его уничтожаешь...

Ответить

Номер ответа: 4
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
  Профиль | | #4 Добавлено: 30.07.06 14:24
Ну лан. В этой процедуре ты создаёшь экземпляр объекта Word. Но я не вижу код, где ты его уничтожаешь...

Ответить

Номер ответа: 5
Автор ответа:
 KVU



Вопросов: 10
Ответов: 32
  Профиль | | #5 Добавлено: 30.07.06 20:35
Уничтажаю
WordApp.Quit False
Set WordApp = Nothing

и не помогает почему то :(

Ответить

Номер ответа: 6
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
  Профиль | | #6 Добавлено: 30.07.06 22:02
ну понятно. А где именно ты уничтожаешь объект? В Form_Unload() или ещё где?

Ответить

Номер ответа: 7
Автор ответа:
 KVU



Вопросов: 10
Ответов: 32
  Профиль | | #7 Добавлено: 31.07.06 21:34
А где бы не уничтожал все равно не работает, и ещё если открыть другой документ word то ругается на код программы

TableWord.Rows(TableWord.Rows.Count).Select
    Selection.InsertRowsBelow 1
    
    TableWord.Cell(TableWord.Rows.Count, 1).Select
    Selection.MoveRight Unit:=wdCharacter, Count:=TableWord.Columns.Count - 2, Extend:=wdExtend
    Selection.Cells.Merge

Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)

Ответить

Номер ответа: 8
Автор ответа:
 KVU



Вопросов: 10
Ответов: 32
  Профиль | | #8 Добавлено: 31.07.06 21:35
А где бы не уничтожал все равно не работает (Set DocWord = Nothing сразу после процедуры), и ещё если открыть другой документ word то ругается на код программы

TableWord.Rows(TableWord.Rows.Count).Select
    Selection.InsertRowsBelow 1
    
    TableWord.Cell(TableWord.Rows.Count, 1).Select
    Selection.MoveRight Unit:=wdCharacter, Count:=TableWord.Columns.Count - 2, Extend:=wdExtend
    Selection.Cells.Merge

Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)

Ответить

Номер ответа: 9
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
  Профиль | | #9 Добавлено: 31.07.06 23:01
на какую строку именно ругается?
смысл в том, что если ты создаёшь экземпляр объекта в какой-то процедуре, то уничтожать его надо в ней же.

Ответить

Номер ответа: 10
Автор ответа:
 LamerOnLine



ICQ: 334781088 

Вопросов: 108
Ответов: 2822
  Профиль | | #10 Добавлено: 01.08.06 11:08
если ты создаёшь экземпляр объекта в какой-то процедуре, то уничтожать его надо в ней же.

Откуда ты эту хрень взял? Бред полный.
2Аффтар. Весь код читать лень, но траблы какие-то у тебя левые. Не поленись, приведи весь код, плиз.

Ответить

Номер ответа: 11
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
  Профиль | | #11 Добавлено: 01.08.06 13:19
я имел в виду в этом случае. Наскока я понял (ибо аффтар этого не уточнял) за один запуск проги мона сформировать несколько раз документ. Он в процедуре создаёт объект, но не уничтожает. Вопрос: занафига? Аффтар опять-таки этого не уточнил. Тем не менее жалуется, что код не работает. Наверняка это из-за того, что аффтар не уничтожает объект в процедуре.

Ответить

Номер ответа: 12
Автор ответа:
 LamerOnLine



ICQ: 334781088 

Вопросов: 108
Ответов: 2822
  Профиль | | #12 Добавлено: 01.08.06 14:04
Да не обязательно уничтожать объект в той же процедуре. Объяви указатель глобальной переменной - и уничтожай в любом месте, независимо от того где ты его создал. Только сначала Quit не надо забывать давать.

Ответить

Номер ответа: 13
Автор ответа:
 KVU



Вопросов: 10
Ответов: 32
  Профиль | | #13 Добавлено: 01.08.06 20:16
Всель код на ПрограссБар не оброщайте внимания и очень силь не ругайте я же не проффи :)

Private Sub cmdPrint_Click()
'On Error GoTo ExitSub:
    ;Dim Rst1 As ADODB.Recordset
    ;Dim Rst2 As ADODB.Recordset
    Set Rst1 = New ADODB.Recordset
    Set Rst2 = New ADODB.Recordset
    ;Dim iProgressBar1 As Integer
    ;Dim iProgressBar2 As Integer

    ;Dim NameReports As String ' Названия отчёта
    ;Dim iColumn As Integer
    ;Dim iRow As Integer
    If lvwReport.ListItems.Count <= 0 Then
        Exit Sub
    End If
    'FRM_STATUSBAR.Show
    'iProgressBar1 = 1
    'iProgressBar2 = 1
    
    iColumn = lvwReport.ColumnHeaders.Count ' Кол-во колонок
    
    
    Set WordApp = New Word.Application
    'WordApp.Visible = True
    Set DocWord = WordApp.Documents.Add
    ;DocWord.Activate

    ;Dim SumCost As Currency ' Переменная для суммирования стоимости работы без КТУ
    ;Dim SumWork As Integer ' Преременная для суммировния выполненных работ
    ;Dim SumKTY As Currency ' Переменная для суммирования КТУ
    ;Dim AllSum As Currency ' Переменная для итоговой суммы денег
    ;Dim AllWork As Currency ' Переменная для итоговой суммы работ
    
    With Rst1
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockBatchOptimistic
    End With
    
    With Rst2
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockBatchOptimistic
    End With
    
   
    
    If Check1.Value = 1 Then
        ;DocWord.PageSetup.Orientation = wdOrientPortrait
        NameReports = "Краткий отчёт за выполненные работы c: "
        
    Else
        ;DocWord.PageSetup.Orientation = wdOrientLandscape
        NameReports = "Полный отчёт за выполненные работы c: "
    End If
   
    ;DocWord.PageSetup.TopMargin = CentimetersToPoints(1.5)
    
    With DocWord.Application.Selection
        .InsertAfter Chr(171) & "RNet" & Chr(187) & " - компьютерная сеть"
        .Font.Size = 20
        .Font.Bold = True
        .Font.Name = "Courier New"
        .Paragraphs.Alignment = wdAlignParagraphCenter
        .InsertParagraphAfter
        .InsertParagraphAfter
        .EndOf
    End With
    
    With DocWord.Application.Selection
        .InsertAfter NameReports & DTPicker1.Value & " по: " & DTPicker2.Value
        .Font.Size = 14
        .Font.Bold = True
        .Font.Name = "Times New Roman"
        .Paragraphs.Alignment = wdAlignParagraphCenter
        .InsertParagraphAfter
        .EndOf
    End With
    
    With DocWord.Application.Selection
        .InsertAfter "Дата и время создание отчёта: " & Now
        .Font.Size = 10
        .Font.Bold = False
        .Font.Name = "Times New Roman"
        .Paragraphs.Alignment = wdAlignParagraphCenter
        .InsertParagraphAfter
        .InsertParagraphAfter
        .EndOf
    End With
    
        
    
    
    If optPers.Value = True Then
        'If Check1.Value = 1 And cbo.Text <> "" Then
           
            


            Rst1.Open ("SELECT * FROM TBL_PERS order by Pers_NAME1";), DataBase
            Rst2.Open ("SELECT * FROM TBL_PERCENTAGE";), DataBase
            iRow = Rst1.RecordCount + 1 ' Кол-во строк ListView + заголовок
            
            ' Создаём таблицу
            Set TableWord = DocWord.Tables.Add(DocWord.Application.Selection.Range, iRow, iColumn)
            ' Заголовок таблицы
            For i = 1 To iColumn
                TableWord.Cell(1, i).Range.Text = lvwReport.ColumnHeaders(i).Text
            Next i
            
            
            Open_Tables (10)
            FRM_STATUSBAR.Show
            FRM_STATUSBAR.ProgressBar2.Max = iRow
            FRM_STATUSBAR.ProgressBar1.Max = RstBase_Open.RecordCount + 1
            MsgBox FRM_STATUSBAR.ProgressBar1.Max
            ;Dim iCol As Integer
            iCol = 1
            For i = 2 To iRow
            'iCol = 1
            iProgressBar1 = 1
            FRM_STATUSBAR.ProgressBar1.Value = iProgressBar1
                ;Do Until RstBase_Open.EOF
                iProgressBar1 = iProgressBar1 + 1
                FRM_STATUSBAR.ProgressBar1.Value = iProgressBar1
                    If Rst1("Pers_ID";).Value = RstBase_Open("Pers_ID";).Value Then
                        TableWord.Cell(i, 1).Range.Text = Trim(Rst1("Pers_NAME1";).Value)
                        TableWord.Cell(i, 2).Range.Text = Rst1("Pers_NAME2";).Value
                        TableWord.Cell(i, 3).Range.Text = Rst1("Pers_NAME3";).Value
                        SumCost = SumCost + RstBase_Open("AddPers_COST";).Value
                        SumWork = SumWork + 1
                        ;Do Until Rst2.EOF ' Подсчёт КТУ
                        'FRM_STATUSBAR.ProgressBar1.Value = iProgressBar1
                            If Rst2("Percentage_ID";).Value = RstBase_Open("AddPers_PERCENTAGE_EX";).Value Then
                                SumKTY = SumKTY + Rst2("Percentage_VOLUME";).Value * RstBase_Open("AddPers_COST";).Value
                                'iProgressBar1 = iProgressBar1 + 1
                                'FRM_STATUSBAR.ProgressBar1.Value = iProgressBar1
                            End If
                            Rst2.MoveNext
                            'iProgressBar1 = iProgressBar1 + 1
                            'FRM_STATUSBAR.ProgressBar1.Value = iProgressBar1
                        Loop
                        Rst2.MoveFirst
                        TableWord.Cell(i, 4).Range.Text = Trim(SumWork)
                        TableWord.Cell(i, 5).Range.Text = FormatCurrency(SumCost, 2)
                        TableWord.Cell(i, 6).Range.Text = FormatCurrency(SumKTY, 2)
                        TableWord.Cell(i, 7).Range.Text = FormatCurrency(SumCost + SumKTY, 2)
                    End If
                    RstBase_Open.MoveNext
                Loop
                    RstBase_Open.MoveFirst
                    Rst1.MoveNext
                    AllSum = AllSum + (SumCost + SumKTY)
                    AllWork = AllWork + SumWork
                    SumCost = 0
                    SumKTY = 0
                    SumWork = 0
            iProgressBar2 = iProgressBar2 + 1
            FRM_STATUSBAR.ProgressBar2.Value = iProgressBar2
            Next i
            AllSum = AllSum + (SumCost + SumKTY)
            AllWork = AllWork + SumWork
    End If
    
    
    
    For i = 1 To TableWord.Rows.Count
        ;Dim StrLen As Integer
        StrLen = Len(TableWord.Cell(i, 1).Range.Text)
        If StrLen <= 2 Then
            TableWord.Rows(i).Delete
            i = i - 1
        End If
    Next i
    TableWord.Rows(TableWord.Rows.Count).Select
    Selection.InsertRowsBelow 1
    
    TableWord.Cell(TableWord.Rows.Count, 1).Select
    Selection.MoveRight Unit:=wdCharacter, Count:=TableWord.Columns.Count - 2, Extend:=wdExtend
    Selection.Cells.Merge
    TableWord.Cell(TableWord.Rows.Count, 1).Range.Text = "Всего:"
    TableWord.Cell(TableWord.Rows.Count, 2).Range.Text = FormatCurrency(AllSum, 2)
   
   '**************************
   '* Форматирование таблицы *
   '**************************
   
   ' Заголовок таблицы
   ' =================
    
    For i = 1 To TableWord.Columns.Count
        With TableWord.Cell(1, i).Range
            .Font.Bold = True
            .Font.Size = 12
            .ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Shading.BackgroundPatternColor = wdColorPaleBlue
            .Cells.VerticalAlignment = wdCellAlignVerticalCenter
        End With
    Next i
    
    ' Тело таблицы
    ' ============

    For x = 2 To TableWord.Rows.Count - 1
        For y = 1 To TableWord.Columns.Count
            With TableWord.Cell(x, y).Range
                .Font.Size = 12
                .ParagraphFormat.Alignment = wdAlignParagraphLeft
            End With
        Next y
    Next x
    
    ' Заключение таблицы
    ' ==================
    With TableWord.Cell(TableWord.Rows.Count, 1).Range
        .Font.Size = 14
        .Font.Bold = True
        '.Font.Color = vbRed
        '.Shading.BackgroundPatternColor = wdColorLightGreen
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
    End With
    
    With TableWord.Cell(TableWord.Rows.Count, 2).Range
        .Font.Size = 14
        .Font.Bold = True
        '.Font.Color = vbRed
        '.Shading.BackgroundPatternColor = wdColorLightGreen
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
    End With

    ' Выравнивание таблицы
    ' ====================
    
    TableWord.Range.Select
    Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    Selection.EndOf
    WordApp.Visible = True
    Set TableWord = Nothing
    Set DocWord = Nothing
    FRM_STATUSBAR.Hide
    Exit Sub
'ExitSub:
' FRM_STATUSBAR.Hide
' WordApp.Quit False
' Set WordApp = Nothing
    
End Sub

Ответить

Номер ответа: 14
Автор ответа:
 Sacred Phoenix



ICQ: 304238252 

Вопросов: 52
Ответов: 927
  Профиль | | #14 Добавлено: 01.08.06 22:03
2 LOL:
Да не обязательно уничтожать объект в той же процедуре. Объяви указатель глобальной переменной - и уничтожай в любом месте, независимо от того где ты его создал. Только сначала Quit не надо забывать давать.
Ну прально, если объявить глобальной. А он объявляет в процедуре. Не, пусть уничтожает Word где хочет, но ему же хуже...

Ответить

Номер ответа: 15
Автор ответа:
 KVU



Вопросов: 10
Ответов: 32
  Профиль | | #15 Добавлено: 01.08.06 22:17
Да не обязательно уничтожать объект в той же процедуре. Объяви указатель глобальной переменной - и уничтожай в любом месте, независимо от того где ты его создал. Только сначала Quit не надо забывать давать.


Это понятно, что нужно уничтожать объект, а если пользователь сам закрыл Word или допустим по помимо сформированного отчета в worde, может у него ещё какие ни будь документы открыты, если уничтожать WordApp.Quit не закроются ли все документы.

Так же если уже открыт другой документ word то программу ругается на Selection.InsertRowsBelow 1 и т.д.

Большое спасибо что помогаете, надеюсь, придём к решению проблемы.

Можете дать пример как правильно загружать и уничтожать объект word

Суть вопроса, нужно, что бы пользователь после формирования отчёта в worde мог ещё раз его сформировать, это же или другой отчёт. Кто изучал код обратили внимания, что там два отчёта краткий и полный.

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам