Блог

Я экспериментировал с добавлением таблиц в word из базы данных.

До сих пор я создавал таблицу в документе Word в качестве шаблона

Затем я копирую его в новый документ Word, ищу DT и Dokumenttype, а затем заменяю его на нужное мне значение. Это происходит достаточно медленно (однако, кажется, что это происходит очень быстро), и, вероятно, было бы лучше создать его непосредственно в word.

После создания таблицы я начинаю добавлять в нее строки, где первый столбец должен быть гиперссылкой. Это то, что, кажется, требует времени, всего 235 строк разбиты на 11 таблиц, но на создание 11 таблиц уходит почти минута. Итак, мой вопрос в том, как вы, ребята, обычно создаете таблицы?

Создаете ли вы заголовок таблицы, а затем продолжаете добавлять строки? Выполняете ли вы двойной цикл, чтобы найти необходимое количество строк, а затем создать всю таблицу за один раз? Вы копируете массив в таблицу, чтобы заполнить строки? Затем переключитесь на гиперссылку на первый столбец? Вывод выглядит следующим образом:

Ниже приведен мой текущий код:

 Option Explicit


Public Sub createDocOut(projectNumber As String, Optional reloadDatabase As Boolean = False)

Dim docOutArray() As String
Dim previousDokType As String
Dim doc_ As Document
Dim i As Long
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim sPercentage As Double
Dim numOfRows As Long

'Application.ScreenUpdating = False
docOutArray = Post.helpRequest("http://proto-ls/wordin.asp?Dok4=" amp; projectNumber)

If CPearson.IsArrayEmpty(docOutArray) Then
    MsgBox "No document registered in database!"
End If

numOfRows = UBound(docOutArray, 1)


' creates a new document if needed otherwise it opens it
Set doc_ = NEwDocOut.createDocOutDocument(projectNumber)

If CustomProperties.getValueFromProperty(doc_, "_DocumentCount") = numOfRows And reloadDatabase = False Then
    Application.ScreenUpdating = True
    Exit Sub
Else
    Selection.WholeStory
    Selection.Delete
End If

'We add number of rows to document
Call CustomProperties.createCustomDocumentProperty(doc_, "_DocumentCount", numOfRows)

j = 0
previousDokType = ""
For i = LBound(docOutArray, 1) To numOfRows

    'new table
    If docOutArray(i, 1) <> previousDokType Then
        If j > 0 Then
            doc_.Tables(j).Select
            Selection.Collapse WdCollapseDirection.wdCollapseEnd
            Selection.MoveDown Unit:=wdLine, Count:=1
        End If
        j = j   1
        m = 2


        Call NEwDocOut.addTable(doc_, docOutArray(i, 1), docOutArray(i, 2))

    End If

    'new row
    With doc_.Tables(j)
        .Rows(m).Select
        Selection.InsertRowsBelow (1)
        m = m   1

        ' Hyper link the file
        ActiveDocument.Hyperlinks.Add Anchor:=.Cell(m, 1).Range, _
        Address:="z:Prosjekt" amp; projectNumber amp; docOutArray(i, 3), ScreenTip:="HyperLink To document", _
        TextToDisplay:=FileHandling.GetFilenameFromPath(docOutArray(i, 3))
        'loop through cells
        For k = 3 To UBound(docOutArray, 2)
        '                .Cell(m, k - 2).Range.Font.Bold = False
        '                .Cell(m, k - 2).Range.Font.name = "Times New Roman"
        '                .Cell(m, k - 2).Range.Font.Size = 10
            If k > 3 And k <> 8 Then
                .Cell(m, k - 2).Range.Text = docOutArray(i, k)
            End If

            If k = 8 Then
                .Cell(m, k - 2).Range.Text = Format(replace(docOutArray(i, k), ".", "/"), "mm.dd.yyyy")
            End If
        Next k
    End With

    previousDokType = docOutArray(i, 1)

Next i

'Application.ScreenUpdating = True

End Sub

'**********************************************************************
' ****** CREATE NEW DOCUMENT OUT **************************************
'**********************************************************************
Function createDocOutDocument(prosjektnumber As String) As Document

Dim dirName As String
Dim docOutname As String

Set createDocOutDocument = Nothing

' Hvis directory DokumentstyringPFK ikke eksisterer, lag dette
dirName = "z:Prosjekt" amp; prosjektnumber

'change permision if needed
If Dir(dirName, vbDirectory) = "" And Not Settings.debugMy Then
  MkDir dirName
End If

'filename of docOut
docOutname = dirName amp; "" amp; prosjektnumber amp; "-Dokut.docx"

If FileHandling.doesFileExist(docOutname) Then
    If FileHandling.openDocument(docOutname, True, True) Then
        Set createDocOutDocument = ActiveDocument
        Exit Function
    End If
End If

'
' Add the tamplate for DocOut and save it to Doclist
'
Set createDocOutDocument = Documents.Add(Template:="Z:DokumentstyringConfigDocOut.dotm", NewTemplate:=False)




createDocOutDocument.SaveAs filename:=docOutname

'Final check if document was created
If Not FileHandling.doesFileExist(docOutname) Then
    Set createDocOutDocument = Nothing
End If


End Function


Function addTable(doc_ As Document, category As String, description As String)
    doc_.Activate
    'Insert out table
    Selection.InsertFile filename:="Z:DokumentstyringConfigDoklistut.docx", Range:="", _
    ConfirmConversions:=False, link:=False, Attachment:=False

    'Replace the DT with the category
     If Not searchAll(doc_, "DT", category) Then
         MsgBox "Failed to replace category in table"
     End If

    'Replace the Dokumenttype with the category
     If Not searchAll(doc_, "Dokumenttype", description) Then
         MsgBox "Failed to replace document type in table"
     End If
End Function