Selecteren tekst tussen twee kopjes en voorzien van alineanummering in Word 2013

Status
Niet open voor verdere reacties.
J

JeanGuillaume

Gebruiker
Lid geworden
9 nov 2015
Berichten
9
Ik wil een macro maken in Word 2013 maar heb helaas de VBA kennis daar nog niet van. De macro dient tekst te selecteren tussen twee kopjes en vervolgens voorzien van een alineanummering.
Voorbeeld:
Aanvraag:

Tekst

Resultaat:

De macro dient de tekst te selecteren en vervolgens te voorzien van een alineanummering waardoor het volgende resultaat moet verschijnen:

Aanvraag:

1 Tekst

Resultaat:

Wie kan mij helpen dit resultaat te krijgen?
 
Waarom maak je niet een stijl met de door jou gewenste nummering, en pas je die toe op de selectie? Is vermoedelijk net zo snel als een macro. En in ieder geval een stuk makkelijker. Zeker als je de stijlen aan elkaar koppelt. Denk dan aan een stijl voor de start van het blok (die je met een sneltoets start) die, na <Enter> automatisch de nummerstijl selecteert voor de volgende alinea en dat volhoudt tot je weer (met een sneltoets) de eindstijl kiest. Dan heb je geen macro nodig.
 
Stijl gebruiken

Hallo OctaFish,
Dat zou inderdaad een oplossing kunnen zijn als je de tekst direct aan het opmaken gaat. In mijn geval betreft het een import van een XML bestand in een bestaand document. Om gebruikers extra werk uit handen te nemen had ik het idee om dit via een macro te regelen.
 
Is de tekst dan wel opgemaakt met herkenbare koppen? En daarmee bedoel ik dan natuurlijk: kun je met een macro bepalen waar de ene kop eindigt (startpunt van je alineaselectie) en de andere kop begint?
 
Zoals je in mijn vraag kunt zien is er een begin en einde kopje. In dit geval Aanvraag: en Resultaat:, de tekst tussen deze beide kopjes moet eerst geselecteerd worden en vervolgens van een alineanummering worden voorzien.
 
Je beantwoord mijn vraag toch niet echt; ik zie wel tekst waarvan jij vind dat het een kop is, maar ik wil dus weten of je die tekst met een beginstijl en een eindstijl hebt gemarkeerd. Want hoe moet je anders de begin- en eindpunt vinden? Puur op de tekst? En is die dan altijd in elk document gelijk? En zo ja: hoe vaak komt die tekst dan voor per document? Je geeft, kortom, niet heel veel informatie om mee te werken :).
 
Sorry dat de vraag en toelichting onduidelijk overkomen.
Het is een vaste tekst zonder stijl maar met vaste kopjes met de benamingen zoals genoemd.
Door de conversie van XML zijn alle stijlen en bookmarks uit de tekst gehaald.
Wel wordt de tekst in de juiste opmaak weergegeven. In mijn geval worden de genoemde kopjes vet gedrukt weergegeven.
De tekst die tussen de kopjes staat is variabel van lengte terwijl de kopjes vast zijn. Dagelijks worden deze teksten toegevoegd tussen de kopjes waarna handmatig een selectie gemaakt wordt en dan de alineanummering wordt toegevoegd.
Ik hoop dat je met deze toelichting uit de voeten kunt.
 
Nou, met een beetje puzzelen is er altijd wel een macro te maken die de klus klaart. Of de door mij geïnvesteerde tijd opweegt tegen de door jou uitgespaarde tijd, da's een heel andere discussie :D.

Code: 
Sub TekstNummeren()
Dim sDoc() As String, sL As String
Dim iStart As Integer, iStop As Integer, i As Integer

    'Regeleindes vervangen door Alineamarkeringen
    Selection.HomeKey Unit:=wdLine
    With Selection.Find
        .ClearFormatting
        .Text = "^l"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Execute
    End With
    With Selection.Find
        .ClearFormatting
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Execute
    End With
    
    'Document inlezen in een matrix om begin- en eindpunt te vinden
    sDoc = Split(ActiveDocument.Content.Text, vbCr)
    For i = LBound(sDoc) To UBound(sDoc)
        If sDoc(i) = "Aanvraag:" Then
            iStart = i
        ElseIf sDoc(i) = "Resultaat:" Then
            iStop = i
            Exit For
        End If
    Next i

    'Nummerstijl definiëren
    sL = ""
    For i = 1 To 9
        With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(i)
            sL = sL & "%" & i & "."
            .NumberFormat = sL
            .TrailingCharacter = wdTrailingTab
            .NumberStyle = wdListNumberStyleArabic
            .NumberPosition = CentimetersToPoints(0.7 * (i - 1))
            .Alignment = wdListLevelAlignLeft
            .TextPosition = CentimetersToPoints(0.7 * i)
            .TabPosition = wdUndefined
            .ResetOnHigher = i - 1
            .StartAt = 1
            .LinkedStyle = ""
        End With
    Next i
    
    'Alinea's in reeks opzoeken en nummeren
    For i = iStart + 2 To iStop
        ActiveDocument.Paragraphs(i).Range.Select
        ListGalleries(wdOutlineNumberGallery).ListTemplates(1).Name = ""
        Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
            ListGalleries(wdOutlineNumberGallery).ListTemplates(1), _
            ContinuePreviousList:=True, ApplyTo:=wdListApplyToSelection, _
            DefaultListBehavior:=wdWord10ListBehavior
    Next i
    Selection.MoveDown Unit:=wdParagraph, Count:=1

End Sub
 
Hallo OctaFish,
Dank je voor het maken van de macro! Ik heb vanochtend de macro getest en de nummering verschijnt goed in beeld. Dank voor je tijd, ik ben ontzettend blij met de macro. Het scheelt mij een hoop muisbewegingen!!!
 
Graag gedaan :). Mag je de vraag op <Opgelost> zetten.
In het blokje Nummerstijl definiëren leg ik de stijl van de nummering vast; hij maakt daar nu 9 niveau's aan (doet Microsoft ook), dat kan je verlagen als dat nodig is (heb je trouwens geen last van als er 9 worden ingesteld) en de inspring afstand staat nu op 0,7 cm voor elk niveau. En dat is nu zo'n eigenschap waar je wel wat mee kunt spelen. Microsoft gebruikt zelf altijd 1/4 inch (0,63 cm) maar dat blijkt in de praktijk veel te weinig. Voor mezelf gebruik ik vaak 1 cm, vind ik mooier. Maar daar kun je dus rustig mee spelen om te kijken wat het beste werkt.
 
Dank voor de toelichting en uitleg. Mocht het nodig zijn, hetgeen ik betwijfel, dan zal ik een en ander aanpassen. De eerste reacties zijn positief! 1 gebruiker kreeg het voor elkaar om ook voor de lege regels een nummering te tonen. Hoe hij dit heeft gedaan is mij een raadsel.
 
Laatst bewerkt:
Da's niet zo moeilijk; de macro zet alle alinea's om die tussen begin- en eindpunt zitten. Dus ook lege. Ach, als je die weghaalt wordt de nummering gelijk aangepast, dus wellicht leren ze er een beetje tekstverwerken van :).
 
Alineanummering aangepast

Zoals in een van de berichten viel te lezen bleken ook lege regels genummerd te worden.
Onderstaande code is door mij aangepast waardoor de lege regels nu worden overgeslagen. Voorwaarde is wel dat er tussen iedere alinea een lege regel staat.

Code:

Code: 
Sub AlineaNummeren()
Dim sDoc() As String, sL As String
Dim iStart As Integer, iStop As Integer, i As Integer

    
    'Regeleindes vervangen door Alineamarkeringen
    Selection.HomeKey Unit:=wdLine
    With Selection.Find
        .ClearFormatting
        .Text = "^l"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Execute
    End With
    With Selection.Find
        .ClearFormatting
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Execute
    End With
    
    'Document inlezen in een matrix om begin- en eindpunt te vinden
    sDoc = Split(ActiveDocument.Content.Text, vbCr)
    For i = LBound(sDoc) To UBound(sDoc)
        If sDoc(i) = "1e kopje" Then
            iStart = i + 2
        ElseIf sDoc(i) = "2e kopje" Then
            iStop = i
            Exit For
        End If
    Next i

    'Nummerstijl definiëren 1.3 is de afstand van de inspringing
    sL = ""
    For i = 1 To 9
        With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(i)
            sL = sL & "%" & i & "."
            .NumberFormat = sL
            .TrailingCharacter = wdTrailingTab
            .NumberStyle = wdListNumberStyleArabic
            .NumberPosition = CentimetersToPoints(1.3 * (i - 1))
            .Alignment = wdListLevelAlignLeft
            .TextPosition = CentimetersToPoints(1.3 * i)
            .TabPosition = wdUndefined
            .ResetOnHigher = i - 1
            .StartAt = 1
            .LinkedStyle = ""
        End With
    Next i
    
    'Alinea's in reeks opzoeken en nummeren.
    For i = iStart + 1 To iStop
        ActiveDocument.Paragraphs(i).Range.Select
        ListGalleries(wdOutlineNumberGallery).ListTemplates(1).Name = ""
        Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
            ListGalleries(wdOutlineNumberGallery).ListTemplates(1), _
            ContinuePreviousList:=True, ApplyTo:=wdListApplyToSelection, _
            DefaultListBehavior:=wdWord10ListBehavior
    i = i + 1
    Next i
    
    Selection.MoveDown Unit:=wdParagraph, Count:=4

End Sub
 
Laatst bewerkt:
Doe ons een lol, en zet CODE tags om je code. Vergelijk jouw code maar eens met de mijne, en zoek de verschillen :). Gaat heel simpel: Bewerk het bericht en typ [/Code] achter de code, en
Code: 
[/COLOR][/B] er [B]voor[/B].
 
Reactie op tags

Excuus, ben nieuw op de site had de codetags niet gezien. Je hebt je lol nu :)
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan