Uitlijnen met strepen in Word

[anoniem]

Heeft iemand (snelle) code die al de zinnen in een Word-bestand aanvult/uitlijnt met een streep of streepjes erachter tot aan de marge? Bijv. Teksttekstteksttekstteksttekst --------------------------------- teksttekstteksttekst----------------------------------------------- Tekstteksttekstteksttekstteksttekstteksttekstteksttekst - tekstteksttekstteksttekstteksttekst---------------------------- Tekstteksttekstteksttekstteksttekstteksttekstteksttekstt teksttekstteksttekstteksttekst---------------------------------- Alvast dank. Bachus

[anoniem]

Tekst op uitvullen zetten (zodat je alleen aan het einde van een alinea de streepjes moet zetten en niet op alle regels). En dan met de macrorecorder opnemen dat je een tab achter alle alinea's plakt (^p vervangen door ^t^p) en die tab rechtslijnend op de rechterkantlijn zet en daarbij een - als uitvulteken gebruikt. Krijg ik dit (controleer de tabpositie, bij mij dus 16 cm): [code:1:01ac803ac8] Sub Macro19() ' ' Macro19 Macro ' Macro recorded 7-6-06 by Paulus ' Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^p" .Replacement.Text = "^t^p" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.WholeStory Selection.ParagraphFormat.TabStops.ClearAll ActiveDocument.DefaultTabStop = CentimetersToPoints(1.27) Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(16), _ Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDashes Selection.HomeKey Unit:=wdStory End Sub [/code:1:01ac803ac8]

[anoniem]

[quote:ebba7c4998="Paulus"]Sub Macro19()[/quote:ebba7c4998] Bedankt Paulus voor je code. Maar het werkt nog niet helemaal, helaas. Er verschijnen her en der extra gestippelde regels (veroorzaakt door de tabs denk ik). Daarnaast wil ik de tekst niet uitgevuld hebben, maar gewoon elke regel (ipv elke alinea) laten volgen door "stippeltjes". Ook de clear tabs moet niet, maar ik heb gemerkt dat dat niet nodig is voor de werking. Zelf heb ik nog geexp met het zetten van een tabstop vlak voor de rightmargin, dan met de cursor op het einde vd zin staan en dan tab doen. Dat lukte slechts gedeeltelijk want dan krijg ik ook extra inspringers en extra gestippelde regels. Paulus, heb je nog een alternatief?? Groet, Bachus

[anoniem]

Je moet dan wel het document onherstelbaar veminken (regeleindes inbouwen) dus opslaan onder een andere naam is geboden. Alleen aan het einde van iedere zin een tab inbouwen werkt niet helemaal, omdat er dan een spatie voor kan staan en die zorgt dat de tab naar de volgende regel wordt gewrapt. Die spatie moet dus verwijderd worden. En dan lukt het aardig. Probeer deze eens: [code:1:0d24a8f1f3] Sub Opvullen() fname = InputBox("Kopie opslaan als:", , "C:\Doc1") If fname <> "" Then ActiveDocument.SaveAs fname Selection.WholeStory Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(16), _ Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDashes Selection.EndKey wdStory numLines = Selection.Information(wdFirstCharacterLineNumber) Selection.HomeKey wdStory For i = 1 To numLines Selection.EndKey Unit:=wdLine Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend If Selection.Text = " " Then Selection.TypeBackspace Else Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeText Text:=vbTab If Selection.Text <> Chr(13) Then Selection.TypeParagraph End If Selection.MoveRight Unit:=wdCharacter, Count:=1 ' Onderstaande regels zorgen er voor dat witregels geen opvulteken krijgen 'Do While Selection.Text = Chr(13) ' i = i + 1 ' If i > numLines Then Exit Do ' Selection.MoveRight Unit:=wdCharacter, Count:=1 'Loop Next i End Sub [/code:1:0d24a8f1f3]

[anoniem]

[code:1:3b36f6eaaf] Sub Opvullen() [/code:1:3b36f6eaaf] Hallo Paulus, ik heb je functie uitgeprobeerd maar het liep toch niet lekker ivm opschuivende zinnen, etc. Een nieuwe bedacht, en die werkt voor mij prima. Geen last van opschuivende zinnen of oude tabs die zijn verwijderd. Het aflijnen begint met de zin waarin "tweeduizend" wordt gevonden. [code:1:3b36f6eaaf] With Selection If .Find.Execute(FindText:="tweeduizend") Then 'indien beginpunt dan .. .WholeStory .ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(16), _ Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDashes Selection.EndKey wdStory .HomeKey wdStory .Find.Execute FindText:="tweeduizend" 'beginnen vanaf "tweeduizend" For i = 1 To 10000 .EndKey Unit:=wdLine 'naar einde zin 'eerst rechts kijken .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend 'selecteer 1e teken rechts naast cursor If .Text = Chr(13) Then .MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend .TypeText Text:=vbTab Else 'als rechts geen Return is dan .MoveLeft Unit:=wdCharacter, Count:=1 'terug naar oude positie .MoveLeft Unit:=wdCharacter, Count:=1 'nog 1 terug om voor de spatie te gaan .TypeText Text:=vbTab End If If .MoveDown(Unit:=wdLine, Count:=1) = 0 Then Exit For 'als de cursor niet meer naar beneden kan dan stoppen Next i Else MsgBox "Het woord waarmee het aflijnen begint, nl. tweeduizend, is niet gevonden. Vandaar dat er niet is afgelijnd." End If End With[/code:1:3b36f6eaaf]

[anoniem]

Hallo, Deze oude draad gaat over een macro in Word waarmee precies wordt bewerkstelligd wat ik nodig heb. Helaas werkt deze macro niet. Waarschijnlijk omdat het een office 2003 macro is. Ik gebruik MsOffice 2010. Ik wil namelijk een macro maken waarmee ik elke regel in word documenten uitvul/opvul met streepjes, zoals gebruikelijk is in bijvoorbeeld het notariaat. Kan iemand me helpen met deze code? Bart