1. 首页
  2. 问答
  3. 使用VBA将Excel导出到Word的问题

使用VBA将Excel导出到Word的问题

2010-10-08 110 views
0

我在将数据从Excel导出到Word时遇到问题。 在Excel工作表中，有一个命令按钮，它会根据日期对数据进行排序（此操作）。然后，这些列的内容（在排序完成后声明为变量）应导出到Word文档。 打开一个word文件可以工作，并且excel的第一列会被导出，但其余的列可以获得它们的头。使用VBA将Excel导出到Word的问题

这是代码

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

来源

2010-10-08 Marc

+2

你似乎存储的标题在E列，在这种情况下，你的排序范围不应该在E启动，但在F.之后，这个宏真的需要很多整理，它会让你的生活变得更容易。你可能希望考虑用于存储数据的数组，你可能希望摆脱很多这些标签。 – Fionnuala 2010-10-09 22:11:55

回答

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

来源

2010-10-12 23:16:22

0

找头的所有实例：= xlGuess并更改为页眉：= xlYes

来源

2010-10-12 23:24:25 halfevil

相关问题

 相关问题