title image


Smiley Re: Randnummern in Word 2000, Teil 2
Hallo RuediHier die modifizierte Version, welche auch diese Anforderung erfüllen sollte:Private Const Position = "rechts"Private Const Offset = 1.8Private Const Breite = 1Private Const Höhe = 0.6Private Const Schriftgrad = 9Private Const Durchschuss = 0Private Const FV = "Standard"Sub AbsätzeNummerieren()  Dim oDoc As Document  Dim Absatz As Paragraph  Dim TF As Shape  Set oDoc = ActiveDocument  Application.ScreenUpdating = False  AlleZahlenLöschen  If Position = "rechts" Then    With oDoc.Sections(1).PageSetup      pOffset = .PageWidth - .LeftMargin - CentimetersToPoints(Offset)    End With  Else    pOffset = CentimetersToPoints(Offset) * -1 'linksbündig  End If  pBreite = CentimetersToPoints(Breite)  pHöhe = CentimetersToPoints(Höhe)  i = 0  For Each Absatz In oDoc.Paragraphs    If Absatz.Style = FV Or FV = "*Alle" Then      i = i + 1      If Absatz.Range.Information(wdVerticalPositionRelativeToTextBoundary)         x = Absatz.Format.SpaceBefore + Durchschuss      Else        x = Absatz.Format.SpaceBefore - Absatz.Format.SpaceAfter + Durchschuss      End If      Set TF = _         oDoc.Shapes.AddTextbox(msoTextOrientationHorizontal, pOffset, x, pBreite, pHöhe, Absatz.Range)      TF.Name = "SW000224" & i      TF.Line.Visible = msoFalse      TF.TextFrame.MarginTop = 0      With TF.TextFrame.TextRange        .Text = i        .ParagraphFormat.Alignment = wdAlignParagraphRight        .Font.Size = Schriftgrad      End With    End If    StatusBar = i & " Absätze verarbeitet..."    DoEvents  Next  Application.ScreenUpdating = True  MsgBox "Ende"End SubPrivate Sub AlleZahlenLöschen()  For Each x In ActiveDocument.Shapes    If InStr(x.Name, "SW000224") = 1 Then x.Delete  NextEnd SubGrussSilvia

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: