У меня проблемы с экспортом данных из Excel в Word.
На листе Excel есть командная кнопка, которая сначала сортирует данные по дате (это работает). Затем содержимое этих столбцов (которые после сортировки объявляются как переменные) следует экспортировать в документ Word.
Открытие файла слова работает, и первый столбец из Excel экспортируется, но остальные столбцы действительно получают свой заголовок.
Это код
Sub CreateDoc()
'Alle gegevens sorteren op datum
Range("E:Z").Select
Selection.Sort Key1:=Range("E6"), Order1:=xlAscending, Header:=xlGuess, _
Orientation:=xlLeftToRight
'Alle leerplandoelstellingen definiëren
Dim Rij12 As String
Rij12 = "TIJD - 1: de kijk op het levensverloop van een mens vanuit enkele levensbeschouwingen uit de eigen omgeving omschrijven en illustreren;"
Dim Rij13 As String
Rij13 = "TIJD - 2: de articulatie van de tijd door christenen en anderen illustreren en duiden;"
Dim Rij14 As String
Rij14 = "TIJD - 3: het belang bespreken van de voorgegeven tijdsstructuur (dag, nacht, week, maand, jaar, de seizoenen, …);"
Dim Rij15 As String
Rij15 = "TIJD - 4: enkele 'eigentijdse' feesten en/of rituelen bevragen op hun levensbeschouwelijk karakter;"
Dim Rij16 As String
Rij16 = "TIJD - 5: het 'in handen nemen' en het 'uit handen geven' van de eigen tijdsbeleving verwoorden;"
Dim Rij17 As String
Rij17 = "TIJD - 6: de eigen leeftijd in het bijzonder op het vlak van 'geloven' typeren."
Dim Rij20 As String
Rij20 = "VERHALEN - 1: het eigen leven omschrijven als een uniek levensverhaal;"
Dim Rij21 As String
Rij21 = "VERHALEN - 2: het appellerende in enkele - ook bijbelse - verhalen aangeven;"
Dim Rij22 As String
Rij22 = "VERHALEN - 3: de grote levensbeschouwingen profileren aan de hand van verhalen;"
Dim Rij23 As String
Rij23 = "VERHALEN - 4: de impact van het christelijk verhaal/levensbeschouwingen in het eigen verhaal aangeven;"
Dim Rij24 As String
Rij24 = "VERHALEN - 5: in vele concrete verhalen, christelijke e.a., de rode draad, dynamiek of sleutel aanduiden;"
Dim Rij25 As String
Rij25 = "VERHALEN - 6:het verhaal 'Jezus' opbouwen en vertellen."
Dim Rij28 As String
Rij28 = "GROEPEN/GEMEENSCHAPPEN - 1: verwoorden en beluisteren wat het betekent bij een groep te behoren;"
Dim Rij29 As String
Rij29 = "GROEPEN/GEMEENSCHAPPEN - 2: verduidelijken welke betekenis een groep kan hebben voor andere groepen en de samenleving;"
Dim Rij30 As String
Rij30 = "GROEPEN/GEMEENSCHAPPEN - 3: het verband aangeven tussen levensbeschouwing en groepsvorming;"
Dim Rij31 As String
Rij31 = "GROEPEN/GEMEENSCHAPPEN - 4: het 'eigene' van een christelijke gemeenschap opsporen en verwoorden;"
Dim Rij32 As String
Rij32 = "GROEPEN/GEMEENSCHAPPEN - 5: bespreken wat het betekent voor een christen in de actuele samenleving tot een minderheid te behoren;"
Dim Rij33 As String
Rij33 = "GROEPEN/GEMEENSCHAPPEN - 6: aangeven hoe de rondtrekkende Jezus voor en met zijn leerlingen bron van leven wordt."
'Namen van de katernen declareren als variabele
Dim Katern1 As String
Katern1 = Worksheets("Theo").Cells(1, "E").Value
Dim Katern2 As String
Katern2 = Worksheets("Theo").Cells(2, "E").Value
Dim Katern3 As String
Katern3 = Worksheets("Theo").Cells(3, "E").Value
Dim Katern4 As String
Katern4 = Worksheets("Theo").Cells(4, "E").Value
Dim Katern5 As String
Katern5 = Worksheets("Theo").Cells(5, "E").Value
Dim Katern6 As String
Katern6 = Worksheets("Theo").Cells(6, "E").Value
Dim Katern7 As String
Katern7 = Worksheets("Theo").Cells(7, "E").Value
Dim Katern8 As String
Katern8 = Worksheets("Theo").Cells(8, "E").Value
Dim Katern9 As String
Katern9 = Worksheets("Theo").Cells(9, "E").Value
Dim Katern10 As String
Katern10 = Worksheets("Theo").Cells(10, "E").Value
Dim Katern11 As String
Katern11 = Worksheets("Theo").Cells(11, "E").Value
Dim Katern12 As String
Katern12 = Worksheets("Theo").Cells(12, "E").Value
Dim Katern13 As String
Katern13 = Worksheets("Theo").Cells(13, "E").Value
Dim Katern14 As String
Katern14 = Worksheets("Theo").Cells(14, "E").Value
Dim Katern15 As String
Katern15 = Worksheets("Theo").Cells(15, "E").Value
Dim Katern16 As String
Katern16 = Worksheets("Theo").Cells(16, "E").Value
Dim Katern17 As String
Katern17 = Worksheets("Theo").Cells(17, "E").Value
Dim Katern18 As String
Katern18 = Worksheets("Theo").Cells(18, "E").Value
Dim Katern19 As String
Katern19 = Worksheets("Theo").Cells(19, "E").Value
Dim Katern20 As String
Katern20 = Worksheets("Theo").Cells(20, "E").Value
Dim Katern21 As String
Katern21 = Worksheets("Theo").Cells(21, "E").Value
Dim Katern22 As String
Katern22 = Worksheets("Theo").Cells(22, "E").Value
'Inhoud van de datumcellen declareren als variabele
'Met deze methode wordt er eerst gekeken naar de inhoud van de datumcel:
'als daar nog het woord "datum" staat, dan wordt de inhoud niet opgeslagen als variabele.
OpnameDatum1:
If Worksheets("Theo").Cells(6, "E").Value = "Datum" Then
GoTo OpnameDatum2
Else: Dim Datum1 As Date
Datum1 = Worksheets("Theo").Cells(6, "E").Value
End If
OpnameDatum2:
If Worksheets("Theo").Cells(6, "F").Value = "Datum" Then
GoTo OpnameDatum3
Else: Dim Datum2 As Date
Datum2 = Worksheets("Theo").Cells(6, "F").Value
End If
OpnameDatum3:
If Worksheets("Theo").Cells(6, "G").Value = "Datum" Then
GoTo OpnameDatum4
Else: Dim Datum3 As Date
Datum3 = Worksheets("Theo").Cells(6, "G").Value
End If
OpnameDatum4:
If Worksheets("Theo").Cells(6, "H").Value = "Datum" Then
GoTo OpnameDatum5
Else: Dim Datum4 As Date
Datum4 = Worksheets("Theo").Cells(6, "H").Value
End If
OpnameDatum5:
If Worksheets("Theo").Cells(6, "I").Value = "Datum" Then
GoTo OpnameDatum6
Else: Dim Datum5 As Date
Datum5 = Worksheets("Theo").Cells(6, "I").Value
End If
OpnameDatum6:
If Worksheets("Theo").Cells(6, "J").Value = "Datum" Then
GoTo OpnameDatum7
Else: Dim Datum6 As Date
Datum6 = Worksheets("Theo").Cells(6, "J").Value
End If
OpnameDatum7:
If Worksheets("Theo").Cells(6, "K").Value = "Datum" Then
GoTo OpnameDatum8
Else: Dim Datum7 As Date
Datum7 = Worksheets("Theo").Cells(6, "K").Value
End If
OpnameDatum8:
If Worksheets("Theo").Cells(6, "L").Value = "Datum" Then
GoTo OpnameDatum9
Else: Dim Datum8 As Date
Datum8 = Worksheets("Theo").Cells(6, "L").Value
End If
OpnameDatum9:
If Worksheets("Theo").Cells(6, "M").Value = "Datum" Then
GoTo OpnameDatum10
Else: Dim Datum9 As Date
Datum9 = Worksheets("Theo").Cells(6, "M").Value
End If
OpnameDatum10:
If Worksheets("Theo").Cells(6, "N").Value = "Datum" Then
GoTo OpnameDatum11
Else: Dim Datum10 As Date
Datum10 = Worksheets("Theo").Cells(6, "N").Value
End If
OpnameDatum11:
If Worksheets("Theo").Cells(6, "O").Value = "Datum" Then
GoTo OpnameDatum12
Else: Dim Datum11 As Date
Datum11 = Worksheets("Theo").Cells(6, "O").Value
End If
OpnameDatum12:
If Worksheets("Theo").Cells(6, "P").Value = "Datum" Then
GoTo OpnameDatum13
Else: Dim Datum12 As Date
Datum12 = Worksheets("Theo").Cells(6, "P").Value
End If
OpnameDatum13:
If Worksheets("Theo").Cells(6, "Q").Value = "Datum" Then
GoTo OpnameDatum14
Else: Dim Datum13 As Date
Datum13 = Worksheets("Theo").Cells(6, "Q").Value
End If
OpnameDatum14:
If Worksheets("Theo").Cells(6, "R").Value = "Datum" Then
GoTo OpnameDatum15
Else: Dim Datum14 As Date
Datum14 = Worksheets("Theo").Cells(6, "R").Value
End If
OpnameDatum15:
If Worksheets("Theo").Cells(6, "S").Value = "Datum" Then
GoTo OpnameDatum16
Else: Dim Datum15 As Date
Datum15 = Worksheets("Theo").Cells(6, "S").Value
End If
OpnameDatum16:
If Worksheets("Theo").Cells(6, "T").Value = "Datum" Then
GoTo OpnameDatum17
Else: Dim Datum16 As Date
Datum16 = Worksheets("Theo").Cells(6, "T").Value
End If
OpnameDatum17:
If Worksheets("Theo").Cells(6, "U").Value = "Datum" Then
GoTo OpnameDatum18
Else: Dim Datum17 As Date
Datum17 = Worksheets("Theo").Cells(6, "U").Value
End If
OpnameDatum18:
If Worksheets("Theo").Cells(6, "V").Value = "Datum" Then
GoTo OpnameDatum19
Else: Dim Datum18 As Date
Datum18 = Worksheets("Theo").Cells(6, "V").Value
End If
OpnameDatum19:
If Worksheets("Theo").Cells(6, "W").Value = "Datum" Then
GoTo OpnameDatum20
Else: Dim Datum19 As Date
Datum19 = Worksheets("Theo").Cells(6, "W").Value
End If
OpnameDatum20:
If Worksheets("Theo").Cells(6, "X").Value = "Datum" Then
GoTo OpnameDatum21
Else: Dim Datum20 As Date
Datum20 = Worksheets("Theo").Cells(6, "X").Value
End If
OpnameDatum21:
If Worksheets("Theo").Cells(6, "Y").Value = "Datum" Then
GoTo OpnameDatum22
Else: Dim Datum21 As Date
Datum21 = Worksheets("Theo").Cells(6, "Y").Value
End If
OpnameDatum22:
If Worksheets("Theo").Cells(6, "Z").Value = "Datum" Then
GoTo Waarschuwing
Else: Dim Datum22 As Date
Datum22 = Worksheets("Theo").Cells(6, "Z").Value
End If
Waarschuwing:
Dim NietIngevuld As Integer
NietIngevuld = Application.CountIf(Sheets("Theo").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 rgeDoc As Range
Dim strSaveFile As String
strSaveFile = "C:\Jaarverslag_Theo_1.doc"
Set wrdApp = New Word.Application
Set docCreate = wrdApp.Documents.Add
'Set rgeDoc = docCreate.Range
wrdApp.Visible = True
With wrdApp
With .Selection
.Font.Name = "Verdana"
.Font.Size = 24
.Font.Bold = True
.TypeText Text:=" Jaarverslag Theo 1"
.TypeParagraph
.Font.Size = 10
.ParagraphFormat.Alignment = 0
.Font.Bold = False
.TypeParagraph
.TypeText Text:="Naam School:"
.TypeParagraph
.TypeText Text:="Naam Leerkracht:"
.TypeParagraph
.TypeText Text:="Naam Klas:"
.TypeParagraph
.TypeText Text:="Schooljaar:"
.TypeParagraph
.TypeText Text:="_____________________________________________________________________"
OpmaakKatern1:
If Datum1 = Empty Then
GoTo Afsluiten
End If
.TypeParagraph 'Hier start katern1
.TypeParagraph
.Font.Size = 12
.Font.Bold = True
.Font.Underline = True
.TypeText Text:=Katern1 'Hier staat de naam van de katern
.Font.Bold = False
.Font.Underline = False
.TypeParagraph
.Font.Size = 10
.Font.Underline = True
.TypeText Text:="Datum:" 'Hier komt de gesorteerde datum, in te lezen als variabele
.Font.Underline = False
.TypeText Text:=" " & Datum1 'Hier komt de gesorteerde datum, in te lezen als variabele (aanhalingstekens verwijderen voor de variabele)
.TypeParagraph
.Font.Underline = True
.TypeText Text:="Gerealiseerde leerplandoelstellingen:"
.Font.Underline = False
'Hier checken wat de exacte inhoud van variabele Katern1 is; op basis daarvan wordt er inhoud weergegeven.
If Katern1 = "Een nieuwe start" Then
GoTo Invulling_EenNieuweStart
ElseIf Katern1 = "Alles heeft zijn tijd" Then
GoTo Invulling_AllesHeeftZijnTijd
ElseIf Katern1 = "De wereld aan je voeten" Then
GoTo Invulling_DeWereldAanJeVoeten
ElseIf Katern1 = "Een levend boek" Then
GoTo Invulling_EenLevendBoek
ElseIf Katern1 = "Drempels" Then
GoTo Invulling_Drempels
ElseIf Katern1 = "Kerstmis" Then
GoTo Invulling_Kerstmis
ElseIf Katern1 = "Confituur of choco" Then
GoTo Invulling_ConfituurOfChoco
ElseIf Katern1 = "Hoe groot is de hemel?" Then
GoTo Invulling_HoeGrootIsDeHemel
ElseIf Katern1 = "Ongelovige Thomas" Then
GoTo Invulling_OngelovigeThomas
ElseIf Katern1 = "Feesten" Then
GoTo Invulling_Feesten
ElseIf Katern1 = "Er is er één jarig!" Then
GoTo Invulling_ErIsErEénJarig
ElseIf Katern1 = "Eén van hart" Then
GoTo Invulling_EénVanHart
ElseIf Katern1 = "Ervoor gaan" Then
GoTo Invulling_ErvoorGaan
ElseIf Katern1 = "Groen gras" Then
GoTo Invulling_GroenGras
ElseIf Katern1 = "RELatie" Then
GoTo Invulling_RELatie
ElseIf Katern1 = "Vele plaatjes" Then
GoTo Invulling_VelePlaatjes
ElseIf Katern1 = "Iedereen fan" Then
GoTo Invulling_IedereenFan
ElseIf Katern1 = "Schattenjacht" Then
GoTo Invulling_Schattenjacht
ElseIf Katern1 = "Lichtbakens" Then
GoTo Invulling_Lichtbakens
ElseIf Katern1 = "Rijke Luis" Then
GoTo Invulling_RijkeLuis
ElseIf Katern1 = "Hemel op aarde" Then
GoTo Invulling_HemelOpAarde
ElseIf Katern1 = "Op bezoek" Then
GoTo Invulling_OpBezoek
End If
OpmaakKatern2:
If Datum2 = Empty Then
GoTo Afsluiten
End If
.TypeParagraph 'Hier start katern2
'.TypeParagraph
.Font.Size = 12
.Font.Bold = True
.Font.Underline = True
.TypeText Text:=Katern2 'Hier staat de naam van de katern
.Font.Bold = False
.Font.Underline = False
.TypeParagraph
.Font.Size = 10
.Font.Underline = True
.TypeText Text:="Datum:" 'Hier komt de gesorteerde datum, in te lezen als variabele
.Font.Underline = False
.TypeText Text:=" " & Datum2 'Hier komt de gesorteerde datum, in te lezen als variabele (aanhalingstekens verwijderen voor de variabele)
.TypeParagraph
.Font.Underline = True
.TypeText Text:="Gerealiseerde leerplandoelstellingen:"
.Font.Underline = False
'Hier checken wat de exacte inhoud van variabele Katern1 is; op basis daarvan wordt er inhoud weergegeven.
If Katern2 = "Een nieuwe start" Then
GoTo Invulling_EenNieuweStart
ElseIf Katern2 = "Alles heeft zijn tijd" Then
GoTo Invulling_AllesHeeftZijnTijd
ElseIf Katern2 = "De wereld aan je voeten" Then
GoTo Invulling_DeWereldAanJeVoeten
ElseIf Katern2 = "Een levend boek" Then
GoTo Invulling_EenLevendBoek
ElseIf Katern2 = "Drempels" Then
GoTo Invulling_Drempels
ElseIf Katern2 = "Kerstmis" Then
GoTo Invulling_Kerstmis
ElseIf Katern2 = "Confituur of choco" Then
GoTo Invulling_ConfituurOfChoco
ElseIf Katern2 = "Hoe groot is de hemel?" Then
GoTo Invulling_HoeGrootIsDeHemel
ElseIf Katern2 = "Ongelovige Thomas" Then
GoTo Invulling_OngelovigeThomas
ElseIf Katern2 = "Feesten" Then
GoTo Invulling_Feesten
ElseIf Katern2 = "Er is er één jarig!" Then
GoTo Invulling_ErIsErEénJarig
ElseIf Katern2 = "Eén van hart" Then
GoTo Invulling_EénVanHart
ElseIf Katern2 = "Ervoor gaan" Then
GoTo Invulling_ErvoorGaan
ElseIf Katern2 = "Groen gras" Then
GoTo Invulling_GroenGras
ElseIf Katern2 = "RELatie" Then
GoTo Invulling_RELatie
ElseIf Katern2 = "Vele plaatjes" Then
GoTo Invulling_VelePlaatjes
ElseIf Katern2 = "Iedereen fan" Then
GoTo Invulling_IedereenFan
ElseIf Katern2 = "Schattenjacht" Then
GoTo Invulling_Schattenjacht
ElseIf Katern2 = "Lichtbakens" Then
GoTo Invulling_Lichtbakens
ElseIf Katern2 = "Rijke Luis" Then
GoTo Invulling_RijkeLuis
ElseIf Katern2 = "Hemel op aarde" Then
GoTo Invulling_HemelOpAarde
ElseIf Katern2 = "Op bezoek" Then
GoTo Invulling_OpBezoek
End If
OpmaakKatern3:
If Datum3 = Empty Then
GoTo Afsluiten
End If
.TypeParagraph 'Hier start katern3
.TypeParagraph
.Font.Size = 12
.Font.Bold = True
.Font.Underline = True
.TypeText Text:=Katern3 'Hier staat de naam van de katern
.Font.Bold = False
.Font.Underline = False
.TypeParagraph
.Font.Size = 10
.Font.Underline = True
.TypeText Text:="Datum:" 'Hier komt de gesorteerde datum, in te lezen als variabele
.Font.Underline = False
.TypeText Text:=" " & Datum3 'Hier komt de gesorteerde datum, in te lezen als variabele (aanhalingstekens verwijderen voor de variabele)
.TypeParagraph
.Font.Underline = True
.TypeText Text:="Gerealiseerde leerplandoelstellingen:"
.Font.Underline = False
'Hier checken wat de exacte inhoud van variabele Katern1 is; op basis daarvan wordt er inhoud weergegeven.
If Katern3 = "Een nieuwe start" Then
GoTo Invulling_EenNieuweStart
ElseIf Katern3 = "Alles heeft zijn tijd" Then
GoTo Invulling_AllesHeeftZijnTijd
ElseIf Katern3 = "De wereld aan je voeten" Then
GoTo Invulling_DeWereldAanJeVoeten
ElseIf Katern3 = "Een levend boek" Then
GoTo Invulling_EenLevendBoek
ElseIf Katern3 = "Drempels" Then
GoTo Invulling_Drempels
ElseIf Katern3 = "Kerstmis" Then
GoTo Invulling_Kerstmis
ElseIf Katern3 = "Confituur of choco" Then
GoTo Invulling_ConfituurOfChoco
ElseIf Katern3 = "Hoe groot is de hemel?" Then
GoTo Invulling_HoeGrootIsDeHemel
ElseIf Katern3 = "Ongelovige Thomas" Then
GoTo Invulling_OngelovigeThomas
ElseIf Katern3 = "Feesten" Then
GoTo Invulling_Feesten
ElseIf Katern3 = "Er is er één jarig!" Then
GoTo Invulling_ErIsErEénJarig
ElseIf Katern3 = "Eén van hart" Then
GoTo Invulling_EénVanHart
ElseIf Katern3 = "Ervoor gaan" Then
GoTo Invulling_ErvoorGaan
ElseIf Katern3 = "Groen gras" Then
GoTo Invulling_GroenGras
ElseIf Katern3 = "RELatie" Then
GoTo Invulling_RELatie
ElseIf Katern3 = "Vele plaatjes" Then
GoTo Invulling_VelePlaatjes
ElseIf Katern3 = "Iedereen fan" Then
GoTo Invulling_IedereenFan
ElseIf Katern3 = "Schattenjacht" Then
GoTo Invulling_Schattenjacht
ElseIf Katern3 = "Lichtbakens" Then
GoTo Invulling_Lichtbakens
ElseIf Katern3 = "Rijke Luis" Then
GoTo Invulling_RijkeLuis
ElseIf Katern3 = "Hemel op aarde" Then
GoTo Invulling_HemelOpAarde
ElseIf Katern3 = "Op bezoek" Then
GoTo Invulling_OpBezoek
End If
Invulling_EenNieuweStart:
If Worksheets("Theo").Rij20_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij20
End If
If Worksheets("Theo").Rij28_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij28
End If
If Worksheets("Theo").Rij30_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij30
End If
Invulling_AllesHeeftZijnTijd:
If Worksheets("Theo").Rij12_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij12
End If
If Worksheets("Theo").Rij13_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij13
End If
If Worksheets("Theo").Rij14_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij14
End If
If Worksheets("Theo").Rij16_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij16
End If
If Worksheets("Theo").Rij22_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij22
End If
Invulling_DeWereldAanJeVoeten:
If Worksheets("Theo").Rij20_2.Value = True Then
.TypeParagraph
.TypeText Text:=Rij20
End If
If Worksheets("Theo").Rij21_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij21
End If
If Worksheets("Theo").Rij23_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij23
End If
If Worksheets("Theo").Rij24_1.Value = True Then
.TypeParagraph
.TypeText Text:=Rij24
End If
End With
End With
Set wrdApp = Nothing
'Data in Excel weer sorteren volgens de volgorde van de inhoudstafel
Eindsorteren:
Range("E:Z").Select
Selection.Sort Key1:=Range("E8"), Order1:=xlAscending, Header:=xlGuess, _
Orientation:=xlLeftToRight
Afsluiten:
Exit Sub
End Sub