VBA自动填充每一行

时间:2019-05-10 02:48:55

标签: excel vba ms-word

首先,我对VBA没有任何经验。我在这里拥有的内容是基于我从各种教程中学到的内容。 我在Excel工作表中有想要插入到MS Word中书签中的数据作为自动填充数据。每行数据将保存为一个MS Word文档文件。我遇到的问题是我不知道如何在下一行中连续自动填充,直到A列中的行为空

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 :(得分:0)

尝试根据以下内容进行尝试:

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文档。