Excel宏停止生成9行后的Word文档

时间:2018-08-29 09:01:00

标签: excel vba ms-word

我用几个(几乎相同)的宏制作了一个不错的Excel文件。目标是填写一个Word模板,填写书签,并使用文件名中的预定义字段保存每个单独的文档。就像一个咒语一样工作...但是它并没有比我的Excel文件的第10行更进一步。所有12个宏都有相同的问题,基本上,宏是相同的,只是字段不同。

我现在拥有的VBA是这样:

Option Explicit

Sub Akkoordverklaring()

  Dim lonLaatsteRij As Long
  Dim rngData As Range
  Dim strVoornaam As String, strAchternaam As String, strSlber As String
  Dim c As Range

With Sheets("Cijferlijst")
    lonLaatsteRij = .Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
End With

  For Each c In rngData
    strVoornaam = c.Value
    strAchternaam = c.Offset(0, 1).Value
    strSlber = c.Offset(0, 12).Value
    Call maakWordDocument(strVoornaam, strAchternaam, strSlber)
  Next c

End Sub

Private Sub maakWordDocument(strVoornaam As String, strAchternaam As String, strSlber As String)

    'maak een verwijzing naar de Microsoft Word 16.0 Object Library!!

    Dim wordApp As Object, WordDoc As Object

    On Error Resume Next

    'kijk of word al open staat
    Set wordApp = GetObject("", "Word.Application")
    'open word
    If wordApp Is Nothing Then
      'If Not open, open Word Application
      Set wordApp = CreateObject("Word.Application")
    End If
    'toon word (of niet, dan op false)
    wordApp.Visible = False
    'open het 'bron'-bestand
    Set WordDoc = wordApp.Documents.Open(ThisWorkbook.Path & "Formulieren\Akkoordverklaring.docx")

    'bladwijzers invullen
    Call InvullenBladwijzer(wordApp, "voornaam", strVoornaam)
    Call InvullenBladwijzer(wordApp, "achternaam", strAchternaam)
    Call InvullenBladwijzer(wordApp, "slber", strSlber)

    'bestand opslaan en alles netjes afsluiten
    wordApp.DisplayAlerts = False
    WordDoc.SaveAs Filename:=ThisWorkbook.Path & "Akkoordverklaring\Akkoordverklaring " & strVoornaam & Space(1) & strAchternaam, FileFormat:=wdFormatDocumentDefault
    WordDoc.Close
    wordApp.Quit
    Set WordDoc = Nothing
    Set wordApp = Nothing
    'wordApp.DisplayAlerts = True

    'On Error GoTo 0


End Sub


Sub InvullenBladwijzer(wordApp As Object, strBladwijzer As String, strTekst As String)

  'tekst invullen in relevante strBladwijzer
  wordApp.Selection.Goto What:=wdGoToBookmark, Name:=strBladwijzer
  wordApp.Selection.TypeText strTekst

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

由于我不是程序员,所以我只知道如何阅读一些VBA。这里的一些用户还通过以上(Excel: change VBA action frome same sheet to another sheet)的VBA帮助我解决了问题

0 个答案:

没有答案