ansaurus

Question

Problems with Excel export to Word using VBA

Answer 1

A:

Is an empty date value being found which is resulting in GoTo Afsluiten (exit sub) getting called prematurely? Also, you're missing some labels. For example, you have GoTo Invulling_OpBezoek but there is no corresponding Invulling_OpBezoek label. It's hard for me to tell you exactly what's wrong without seeing the actual Excel data, but those would be my first guesses. As Remou said, you should try to avoid labels and GoTo statements. You should also try using arrays to store some of those values. Here's a quick and dirty cleanup of the code you posted. I took some of the Word formatting code out for simplicity but it should give you an idea of the direction you should go with this. I also only added code to one of the select case statements because, as I said, not all your GoTo statements had corresponding labels.

Sub CreateDoc()

Dim Katern(21) As String, DatumValues(21) As String
Dim TheoSheet As Worksheet
Dim i As Integer, NietIngevuld As Integer

'Alle gegevens sorteren op datum
Range("E6").CurrentRegion.Sort Key1:=Range("E6"), Order1:=xlAscending, Header:=xlGuess, Orientation:=xlLeftToRight

Set TheoSheet = Worksheets("Theo")

'Namen van de katernen declareren als variabele
For i = LBound(Katern) To UBound(Katern)

    Katern(i) = TheoSheet.Cells(i + 1, 5).Value

Next i

For i = LBound(DatumValues) To UBound(DatumValues)

    If TheoSheet.Cells(6, i + 6).Value <> "Datum" Then

        DatumValues(i) = TheoSheet.Cells(6, i + 6).Value

    End If

Next i

NietIngevuld = Application.CountIf(TheoSheet.Range("E6:Z6"), "Datum")
MsgBox ("Er is bij " & NietIngevuld & " katernen geen datum ingevuld."), vbOKOnly, "Jaarplanmodule Theo 1"

'Code van de export-engine
Dim wrdApp As Word.Application
Dim docCreate As Word.Document
Dim strSaveFile As String
Dim body As Word.Range

strSaveFile = "C:\Jaarverslag_Theo_1.doc"

Set wrdApp = New Word.Application
Set docCreate = wrdApp.Documents.Add
wrdApp.Visible = True

Set body = docCreate.StoryRanges(wdMainTextStory)

body.Text = "             Jaarverslag Theo 1" & Chr(13)
body.InsertAfter "Naam School:" & Chr(13)
body.InsertAfter "Naam Leerkracht:" & Chr(13)
body.InsertAfter "Naam Klas:" & Chr(13)
body.InsertAfter "Schooljaar:" & Chr(13)
body.InsertAfter "_____________________________________________________________________" & Chr(13)

For i = LBound(DatumValues) To UBound(DatumValues)

    If DatumValues(i) = "" Then

        Exit Sub

    End If

    body.InsertAfter Chr(13) & Katern(i) & Chr(13)
    body.InsertAfter "Datum: " & DatumValues(i) & Chr(13)
    body.InsertAfter "Gerealiseerde leerplandoelstellingen:"

    Select Case Katern(i)

        Case "Een nieuwe start"

            If TheoSheet.Rij20_1.Value Then

                body.InsertAfter "your text string here"

            ElseIf TheoSheet.Rij28_1.Value Then

                body.InsertAfter "your text string here"

            ElseIf TheoSheet.Rij30_1.Value Then

                body.InsertAfter "your text string here"

            End If

        Case "Alles heeft zijn tijd"
            'do stuff
        Case "De wereld aan je voeten"
            'do stuff
        Case "Een levend boek"
            'do stuff
        Case "Drempels"
            'do stuff
        Case "Kerstmis"
            'do stuff
        Case "Confituur of choco"
            'do stuff
        Case "Hoe groot is de hemel?"
            'do stuff
        Case "Ongelovige Thomas"
            'do stuff
        Case "Feesten"
            'do stuff
        Case "Er is er één jarig!"
            'do stuff
        Case "Eén van hart"
            'do stuff
        Case "Ervoor gaan"
            'do stuff
        Case "Groen gras"
            'do stuff
        Case "RELatie"
            'do stuff
        Case "Vele plaatjes"
            'do stuff
        Case "Iedereen fan"
            'do stuff
        Case "Schattenjacht"
            'do stuff
        Case "Lichtbakens"
            'do stuff
        Case "Rijke Luis"
            'do stuff
        Case "Hemel op aarde"
            'do stuff
        Case "Op bezoek"
            'do stuff

    End Select

Next i

Set wrdApp = Nothing

'Data in Excel weer sorteren volgens de volgorde van de inhoudstafel
Range("E:Z").CurrentRegion.Sort Key1:=Range("E8"), Order1:=xlAscending, Header:=xlGuess, Orientation:=xlLeftToRight

End Sub

Nick 2010-10-12 23:16:22

Answer 2

A:

find all instances of Header:=xlGuess and change them to Header:=xlYes

halfevil 2010-10-12 23:24:25

Answer 3

A:

Thanks for the suggestions and adaptations, Nick and Remou!

I will try a new version without the labels and the GoTo-references. Thanks for helping me out!

Kind regards, Marc

marc 2010-10-13 14:44:20

ansaurus

tags:

views:

answers:

Problems with Excel export to Word using VBA

related questions