我在将数据从Excel导出到Word时遇到问题。 在Excel工作表中，有一个命令按钮，它首先根据日期对数据进行排序（这是有效的）。然后，应将这些列的内容（在完成排序后声明为变量）导出到Word文档。 打开一个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
答案 0 :(得分：0)
是否找到了一个空日期值，导致GoTo Afsluiten（退出子）过早被调用？此外，你错过了一些标签。例如，您有GoTo Invulling_OpBezoek但没有相应的Invulling_OpBezoek标签。如果没有看到实际的Excel数据，我很难告诉你到底出了什么问题，但这些都是我的第一次猜测。正如Remou所说，你应该尽量避免使用标签和GoTo语句。您还应该尝试使用数组来存储其中的一些值。这是您发布的代码的快速和脏的清理。为简单起见，我提取了一些Word格式代码，但它应该让您了解应该采用的方向。我也只在其中一个select case语句中添加了代码，因为正如我所说，并非所有GoTo语句都有相应的标签。
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
答案 1 :(得分：0)
找到Header的所有实例：= xlGuess并将它们更改为Header：= xlYes