Блог

Я создаю Excel-инструмент, в котором у вас будет маска ввода. После завершения и нажатия кнопки «Выполнить» он автоматически создаст каталоги, включающие worddocuments, из шаблонов с помощью предопределенных текстовых маркеров. Теперь проблема:

В этих шаблонах есть таблицы, и я хочу предоставить этим таблицам столько строк, сколько им действительно нужно, и я совершенно не представляю, как это решить. Ниже приведен код для автоматического заполнения:

 Public Function Txtmkr_SDD()

Dim appWord             As Object 'Word-Instance
Dim wdDoc               As Object 'Word-Document
Dim wdRngE              As Object 'Word-Range 1
Dim wdRngR              As Object 'Word-Range 2
Dim wdRngC              As Object 'Word-Range 3
Dim wdRngCN             As Object 'Word-Range 4

Dim wks                 As Worksheet 'Excel-Worksheet
Dim AdresseCE           As String
Dim neueAdresseCE       As Long
Dim Processname1        As String
Dim Processname2        As String
Dim Version             As String

Dim IDPath As String
If TB_ID.Value = vbNullString Then TB_ID = IDPath Else IDPath = (TB_ID.Value) amp; Chr(32)


'*** Word start ***
Set appWord = CreateObject("Word.Application")

'*** opens File ***
Set wdDoc = appWord.Documents.Add(Template:=Worksheets("StartPage").Cells(48, 4) amp; "Document_TemplatesSDD_Template.dotx", NewTemplate:=False, DocumentType:=0)

'*** Word visible ***
appWord.Visible = True

'*** just in case Document is protected ***
'doc.Unprotect

'*** Jump to Textmarker in Word ***
'*** Check of existence ***
'*** Take Value from "CopyData" Cell "B1" and insert Textmarker ***
If wdDoc.Bookmarks.Exists("Processname1") Then
    With wdDoc.Bookmarks("Processname1")
        Set wdRngE = .Range
        wdRngE.Text = Worksheets("CopyData").Cells(1, 2).Value
        wdDoc.Bookmarks.Add "Processname1", wdRngE
    End With
Else
    MsgBox "Missing Link [Processname1]."
End If

  '*** Take Value from "CopyData" Cell "B2" and insert Textmarker ***
If wdDoc.Bookmarks.Exists("Processname2") Then
    With wdDoc.Bookmarks("Processname2")
        Set wdRngE = .Range
        wdRngE.Text = Worksheets("CopyData").Cells(2, 2).Value
        wdDoc.Bookmarks.Add "Processname2", wdRngE
    End With
Else
    MsgBox "Missing Link [Processname2]."
End If


  If wdDoc.Bookmarks.Exists("SDDVersion") Then
    With wdDoc.Bookmarks("SDDVersion")
        Set wdRngE = .Range
        wdRngE.Text = Worksheets("CopyData").Cells(3, 2).Value
        wdDoc.Bookmarks.Add "SDDVersion", wdRngE
    End With
Else
    MsgBox "Missing Link [Version]."
End If


      If wdDoc.Bookmarks.Exists("Create_Date") Then
    With wdDoc.Bookmarks("Create_Date")
        Set wdRngE = .Range
        wdRngE.Text = Worksheets("CopyData").Cells(4, 2).Value
        wdDoc.Bookmarks.Add "Create_Date", wdRngE
    End With
Else
    MsgBox "Missing Link [Create_Date]."
End If


          If wdDoc.Bookmarks.Exists("SDDAuthor") Then
    With wdDoc.Bookmarks("SDDAuthor")
        Set wdRngE = .Range
        wdRngE.Text = Worksheets("CopyData").Cells(6, 2).Value
        wdDoc.Bookmarks.Add "SDDAuthor", wdRngE
    End With
Else
    MsgBox "Missing Link [Author]."
End If




          If wdDoc.Bookmarks.Exists("ProcessID") Then
    With wdDoc.Bookmarks("ProcessID")
        Set wdRngE = .Range
        wdRngE.Text = Worksheets("CopyData").Cells(20, 2).Value
        wdDoc.Bookmarks.Add "ProcessID", wdRngE
    End With
Else
    MsgBox "Missing Link [Author]."
End If

'*** Set Time_Date and SDD Path ***
 Dim time_date As String
 time_date = Format(Date, "yyyy_mm_dd")
 Dim SDD As String
 Dim shp As Shape

'*** Define SDD as Filename ***
SDD = (time_date amp; "_" amp; Worksheets("CopyData").Cells(1, 2).Value amp; "_" amp; Worksheets("CopyData").Cells(21, 2).Value amp; "_" amp; Worksheets("Helper#3").Cells(3, 2).Value amp; "_" amp; "V" amp; Worksheets("CopyData").Cells(3, 2).Value amp; ".docx")

'*** Dim wdApp As Word.Application ***
Set wdApp = GetObject(, "Word.Application")
'*** Set up SavePath amp; Filename ***
appWord.ActiveDocument.SaveAs Worksheets("Variables").Cells(3, 8).Value amp; "" amp; IDPath amp; (Worksheets("Setup#2_DirectoryList").Cells(1, 1)) amp; "" amp; Worksheets("Setup#2_DirectoryList").Cells(3, 3).Value amp; "" amp; Worksheets("Setup#2_DirectoryList").Cells(14, 21).Value amp; "" amp; SDD

'*** Updates the Footer in Word ans saves the file ***
Application.ScreenUpdating = True
With appWord.ActiveDocument
    .Fields.Update
    .PrintPreview
    .ClosePrintPreview

Application.ScreenUpdating = True
appWord.ActiveDocument.Save

 For Each shp In doc.Shapes
    With shp.TextFrame
        If .HasText Then
            shp.TextFrame.TextRange.Fields.Update
        End If
    End With

Next

End With

'*** Word quit ***
appWord.ActiveDocument.Close
appWord.Quit

'*** set Variables free ***
Set wdRngE = Nothing
Set wdRngR = Nothing
Set wdRngC = Nothing
Set wdRngCN = Nothing
Set wdRng = Nothing
Set wdDoc = Nothing
Set appWord = Nothing
Set sFolder = Nothing  
End Function
  

Этот работает так, как и должен, для обычных текстовых маркеров, но теперь мне нужны динамические таблицы, потому что даже если входные данные дают, возможно, 20 строк для содержимого — они не должны быть заполнены полностью в окончательном worddocument.

Было бы очень приятно, если бы кто-нибудь знал, как это сделать.

Кроме того: thx беспокоил папу за редактирование

Для дальнейших запросов; вот как это выглядит на данный момент (лист Excel, на котором выполняется макрос)

Excel-инструмент с макросом
Макрос должен предоставлять больше строк, если действительно имеется 10 учетных записей, но также должно быть только 3, 4 и т.д., Поэтому я ищу способ их динамического добавления

Сначала вам нужно создать закладку, выбрав всю таблицу в файле шаблона и добавив закладку

 Sub test()
        Dim WA As Object, WD As Object
        TempFolder = ThisWorkbook.path amp; "Temp"
        TemplateName = ThisWorkbook.path amp; "file.docx"
            Set WA = CreateObject("Word.Application")
                'WA.Visible = False
            Set WD = WA.Documents.Add(TemplateName)
                With WD
                    If IsBM(WD, "Table_Info") Then ' Check if Bookmark Exist
                        With .Bookmarks.Item("Table_Info").range.Tables(1) ' Work on Table Bookmarked as Table_Info
                            ColN = 1
                            For RowN = 1 To 10
                                .Rows(RowN).Cells(ColN).range.Text = "Col= " amp; ColN amp; " Row= " amp; RowN '"Column1RowN"
                                .Rows(RowN).Cells(ColN   1).range.Text = "Col= " amp; ColN amp; " Row= " amp; RowN '"Column2RowN"
                                .Rows(RowN).Cells(ColN   2).range.Text = "Col= " amp; ColN amp; " Row= " amp; RowN '"Column3RowN"
                            Next RowN
                        End With
                        .Bookmarks.Item("Table_Info").Delete
                    End If
                End With
            WD.SaveAs TempFolder amp; "1.docx"
            WD.Close False
            Set WD = Nothing
            WA.Quit False
            Set WA = Nothing
    End Sub


    Function IsBM(ByVal WDs As Object, ByVal BookMarkName As String) As Boolean
        On Error Resume Next
            IsBM = WDs.Bookmarks.Exists(BookMarkName)
    End Function