Question

当我尝试使用宏的第一个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的设置，以便同事也可以使用它。这就是为什么我决定将所有按钮放在单独的纸上的原因。

Answer 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

Excel：将VBA操作从同一工作表更改为另一工作表

1 个答案: