我用几个(几乎相同)的宏制作了一个不错的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帮助我解决了问题