0

当我尝试使用宏的第一个 Excel 时，我真的可以使用一些帮助。我不是程序员，但我可以很好地编辑一些代码。

我的目标是通过单击一个按钮来生成一些不同的 word 文档。excel文件是一个学生成绩列表。结果列在不同的word文档中。这是一种邮件合并，但没有打开 Word。

我现在拥有的代码是在同一张表中的一个按钮来生成这些 word 文档。现在我更改了整个 excel 文件......我迷失了 VBA。我知道这与以下内容有关：

Sub Selecteren_Cijferlijst()

' Selecteren_Cijferlijst Macro
    Sheets("Cijferlijst").Select

End Sub

我从论坛上一位好心的用户那里得到的代码是这样的：

Option Explicit

Sub Vooraanmelding()

Dim lonLaatsteRij As Long
Dim rngData As Range
Dim strGeboortedatum As String, strStudentnummer As String, strVoornaam As String, strAchternaam As String, strAdres As String, strPostcode As String, strWoonplaats As String, strTelefoon As String, strEmail As String, strCrebo As String, strKlas As String, strProfiel As String, strSlber As String
Dim c As Range

With ActiveSheet
'bepaal de onderste rij van het actieve excel-werkblad
lonLaatsteRij = .Cells(Rows.Count, "A").End(xlUp).Row
'stel bereik in
Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
End With

For Each c In rngData
c.Select
strGeboortedatum = c.Offset(0, 7).Value
strStudentnummer = c.Offset(0, 2).Value
strVoornaam = c.Value
strAchternaam = c.Offset(0, 1).Value
strAdres = c.Offset(0, 4).Value
strPostcode = c.Offset(0, 5).Value
strWoonplaats = c.Offset(0, 6).Value
strTelefoon = c.Offset(0, 8).Value
strEmail = c.Offset(0, 9).Value
strCrebo = c.Offset(0, 10).Value
strKlas = c.Offset(0, 3).Value
strProfiel = c.Offset(0, 11).Value
strSlber = c.Offset(0, 12).Value
Call maakWordDocument(strGeboortedatum, strStudentnummer, strVoornaam, 
strAchternaam, strAdres, strPostcode, strWoonplaats, strTelefoon, strEmail, 
strCrebo, strKlas, strProfiel, strSlber)
Next c

End Sub

Private Sub maakWordDocument(strGeboortedatum As String, strStudentnummer As String, strVoornaam As String, strAchternaam As String, strAdres As String, strPostcode As String, strWoonplaats As String, strTelefoon As String, strEmail As String, strCrebo As String, strKlas As String, strProfiel 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 & "Vooraanmelding\Vooraanmelding.docx")

'bladwijzers invullen
Call InvullenBladwijzer(wordApp, "geboortedatum", strGeboortedatum)
Call InvullenBladwijzer(wordApp, "studentnummer", strStudentnummer)
Call InvullenBladwijzer(wordApp, "voornaam", strVoornaam)
Call InvullenBladwijzer(wordApp, "achternaam", strAchternaam)
Call InvullenBladwijzer(wordApp, "adres", strAdres)
Call InvullenBladwijzer(wordApp, "postcode", strPostcode)
Call InvullenBladwijzer(wordApp, "woonplaats", strWoonplaats)
Call InvullenBladwijzer(wordApp, "telefoon", strTelefoon)
Call InvullenBladwijzer(wordApp, "email", strEmail)
Call InvullenBladwijzer(wordApp, "crebo", strCrebo)
Call InvullenBladwijzer(wordApp, "klas", strKlas)
Call InvullenBladwijzer(wordApp, "profiel", strProfiel)
Call InvullenBladwijzer(wordApp, "slber", strSlber)

'bestand opslaan en alles netjes afsluiten
wordApp.DisplayAlerts = False
WordDoc.SaveAs Filename:=ThisWorkbook.Path & "Vooraanmelding\Vooraanmelding " & strVoornaam & Space(1) & strAchternaam, FileFormat:=wdFormatDocument
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

这段代码是有人给我的，它是我拥有的文件的快速“n”解决方案。现在我更改了我的 Excel 设置，以便我的同事也可以使用它。这就是为什么我决定将所有按钮放在单独的工作表上。

4

1 回答 1

1

您需要使用rngData工作表直接限定您的范围，而不是依赖ActiveSheet.

删除第一个子和链接按钮Sub Vooraanmelding

With Sheets("Cijferlijst")
    lonLaatsteRij = .Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
End With
于 2018-07-16T19:50:27.577 回答