0

As I'm trying my first Excel with macro's I could really use some help. I'm not a programmer but I can edit some code very well.

My goal is to generate some different word documents by the click of a button. The excel file is a list with achievements of students. The results are listed in the different word documents. It's kind of a mail merge but without opening Word.

The code I have now is for a button in the same sheet to generate those word documents. Now I changed the whole excel file...and I'm lost with the VBA. I know it has something to do with:

Sub Selecteren_Cijferlijst()

' Selecteren_Cijferlijst Macro
    Sheets("Cijferlijst").Select

End Sub

The code I got from a kind user on a forum is this:

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

This code is what someone gave me, it was a quick 'n' dirty solution for the file I had. Now I changed the setup of my excel so my colleagues also can work with it. That's why I decided to put all buttons on a separate sheet.

Cindy Meister
  • 25,071
  • 21
  • 34
  • 43
Sypie
  • 15
  • 1
  • 1
  • 6
  • what is the sheet name where you get all of your values? (where is `rngData`?) – urdearboy Jul 16 '18 at 19:47
  • `With ActiveSheet` >> `With Sheets("Cijferlijst")` – Tim Williams Jul 16 '18 at 19:48
  • @urdearboy The sheet all values are from is called Cijferlijst. In the old file it used to have the buttons and all the values on the same sheet. Now I'm trying to change the whole file so the buttons have their own sheet. Just to have everything clear for my colleagues. – Sypie Jul 16 '18 at 19:50

1 Answers1

1

You need to directly qualify your range rngData with a sheet and not rely on ActiveSheet.

Delete first sub and link buttons to Sub Vooraanmelding

With Sheets("Cijferlijst")
    lonLaatsteRij = .Cells(Rows.Count, "A").End(xlUp).Row
    Set rngData = .Range(.Cells(2, 1), .Cells(lonLaatsteRij, 1))
End With
David Zemens
  • 53,033
  • 11
  • 81
  • 130
urdearboy
  • 14,439
  • 5
  • 28
  • 58
  • I Changed it. Now VBA gives an error in the next statement: For Each c In rngData c.Select This c.Select isn't right? – Sypie Jul 16 '18 at 19:58
  • Delete `c.Select` – urdearboy Jul 16 '18 at 19:58
  • 1
    You do not need to `Select` a cell to know its location, change, copy, or delete it when using VBA. – urdearboy Jul 16 '18 at 19:59
  • I did delete it. Now the private sub gives an error: a variable is not defined. – Sypie Jul 16 '18 at 20:02
  • Could you be a bit more specific? As I don't have a lot of knowledge about VBA I have no idea how or where to put this. – Sypie Jul 16 '18 at 20:29
  • 1
    What line is highlighted? The variable needs to be defined (`Dim ? as ?`) @DavidZemens OP already has option explicit which is why he is getting the error. – urdearboy Jul 16 '18 at 20:31
  • The highlighted line is the line that starts with "Private Sub maakWordDocument". – Sypie Jul 16 '18 at 20:33
  • It should highlight the offending variable in blue, like screenshot here: https://imgur.com/gTCn3Zg – David Zemens Jul 16 '18 at 20:38
  • Obvious culprit, unless you have reference to Microsoft Word, would be `wdFormatDocument` which is a Word constant that is not normally available in Excel unless you declare it yourself or add a project reference to Word. – David Zemens Jul 16 '18 at 20:39
  • 1
    @DavidZemens: My bad, I thought the yellow line was higlighted, but that is probably the step VBA is blocked. The highlighted word is indeed wdFormatDocument, furter in the WordDoc.SaveAs line. – Sypie Jul 16 '18 at 20:45
  • I Got it sorted out, kind of... These lines are now outcommented: ** 'wordApp.DisplayAlerts = False 'On Error GoTo 0** And **Set wordApp = GetObject("", "Word.Application")** has now 2 double brackets before "Word.Application" The VBA runs like I want it to run, without errors. Needless to say: the code is a "quick 'n' dirty" one, I have totally no clue on how to get this a quality code. Thanks for helping out. – Sypie Jul 16 '18 at 21:47