Автозаполнение VBA для каждого ряда - PullRequest
0 голосов
/ 10 мая 2019

Прежде всего, у меня нет опыта работы с VBA. То, что я имею здесь, основано на том, что я прочитал из различных уроков. У меня есть данные в листе Excel, которые я хотел вставить в закладки в MS Word для автоматического заполнения. Каждая строка данных будет сохранена как один файл документа MS Word. У меня проблема в том, что я не знаю, как непрерывно автоматически заполнять следующую строку, пока строка в столбце А не станет пустой

Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim mywdRange As Word.Range
Dim Tagno As Range
Dim Csheetno As Range

Set wdApp = New Word.Application
With wdApp
.Visible = True
.WindowState = wdWindowStateMaximize
End With

'Autofill start
'-----Set Range-----
Set myDoc = wdApp.Documents.Add(Template:="C:\Template\" & Range("B2") & ".docx")
Set Tagno = Sheets("Autofill").Range("A2")
Set Csheetno = Sheets("Autofill").Range("B2")

'-----Paste to msWord bookmarks-----
With myDoc.Bookmarks
.Item("tagno").Range.InsertAfter Tagno
.Item("csheetno").Range.InsertAfter Csheetno
End With

myDoc.SaveAs "C:" & "\" & Range("A2") & "_" & Range("B2") & ".docx"
myDoc.Close False
wdApp.Quit

Set doc = Nothing
Set wd = Nothing

1 Ответ

0 голосов
/ 11 мая 2019

Попробуйте что-нибудь на основе:

Sub Demo()
Dim wdApp As New Word.Application, wdDoc As Word.Document, r As Long
'Hide Word
wdApp.Visible = False
'Create, populate & save Word documents, 1 per row.
With Sheets("Autofill")
  For r = 2 To .UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
    If .Range("A" & r).Text = "" Then GoTo ErrExit
    'Create document
    Set wdDoc = wdApp.Documents.Add(Template:="C:\Template\" & .Range("B" & r).Text & ".docx")
    '-----Update Word bookmarks-----
    wdDoc.Bookmarks("tagno").Range.InsertAfter .Range("A" & r).Text
    wdDoc.Bookmarks("csheetno").Range.InsertAfter .Range("B" & r).Text
    'Save & close document
    wdDoc.SaveAs "C:" & "\" & .Range("A" & r).Text & "_" & .Range("B" & r).Text & ".docx", _
      FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    wdDoc.Close False
  Next
End With
ErrExit:
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

Примечание: Вы должны использовать шаблоны Word в качестве шаблонов, а не документы Word.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...