2te Faltmarke

Computer: Software & Programmierung Office Software
1

Hallo Wissende,
nachfolgenden Code fand ich auf der Seite die in der Brettbeschreibung erwähnt wird.
Wie muss ich den Code abändern, dass ie 2te Faltmarke auch angezeigt wird?
Gruß ^ Danke
Reinhard

Sub FaltUndLochmarkeEinfügen()
 Dim oKz As HeaderFooter, FM As Shape, LM As Shape
 savEnv = ActiveWindow.View
 Set oKz = ActiveDocument.Sections(1).Headers(1)
 On Error Resume Next
 Set FM = oKz.Shapes("RP200307241")
 If FM Is Nothing Then
 'Die Länge des Striches (Faltmarke) beträgt 1,2 - 0,5 = 0,7 cm
 Set FM = oKz.Shapes.AddLine(CentimetersToPoints(0.5), \_
 CentimetersToPoints(10.4), \_
 CentimetersToPoints(1.2), \_
 CentimetersToPoints(10.4))
 FM.Name = "RP200307241"
 FM.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
 FM.RelativeVerticalPosition = wdRelativeVerticalPositionPage
 FM.Line.Weight = 0.25
 FM.LockAnchor = True
 End If
 Set LM = oKz.Shapes("RP200307242")
 If LM Is Nothing Then
 'Die Länge des Striches (Lochmarke) beträgt 0,9 - 0,5 = 0,4 cm
 Set LM = oKz.Shapes.AddLine(CentimetersToPoints(0.5), \_
 CentimetersToPoints(14.85), \_
 CentimetersToPoints(0.9), \_
 CentimetersToPoints(14.85))
 LM.Name = "RP200307242"
 LM.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
 LM.RelativeVerticalPosition = wdRelativeVerticalPositionPage
 LM.Line.Weight = 0.25
 LM.LockAnchor = True
 End If
 ActiveWindow.View = savEnv
End Sub
2

Hallo Wissende,
nachfolgenden Code fand ich auf der Seite die in der
Brettbeschreibung erwähnt wird.
Wie muss ich den Code abändern, dass ie 2te Faltmarke auch
angezeigt wird?
Gruß ^ Danke
Reinhard

Hallo Rheinhard,

mit folgenden Anpassungen wird eine 2. Faltmarke erzeugt. Die Position und Länge muss Du ggf. noch nach Deinen Wünschen anpassen. Die Namen der Shapes („RP200307241“, „RP200307242“ und „RP200307243“) kannst Du natürlich auch noch verändern.

Sub FaltUndLochmarkeEinfügen()
 Dim oKz As HeaderFooter, FM As Shape, FM2 As Shape, LM As Shape
 savEnv = ActiveWindow.View
 Set oKz = ActiveDocument.Sections(1).Headers(1)
 On Error Resume Next
 Set FM = oKz.Shapes("RP200307241")
 If FM Is Nothing Then
 'Die Länge des Striches (Faltmarke) beträgt 1,2 - 0,5 = 0,7 cm
 Set FM = oKz.Shapes.AddLine(CentimetersToPoints(0.5), \_
 CentimetersToPoints(10.4), \_
 CentimetersToPoints(1.2), \_
 CentimetersToPoints(10.4))
 FM.Name = "RP200307241"
 FM.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
 FM.RelativeVerticalPosition = wdRelativeVerticalPositionPage
 FM.Line.Weight = 0.25
 FM.LockAnchor = True
 End If
 Set FM2 = oKz.Shapes("RP200307243")
 If FM2 Is Nothing Then
 'Die Länge des Striches (Faltmarke) beträgt 1,2 - 0,5 = 0,7 cm
 Set FM2 = oKz.Shapes.AddLine(CentimetersToPoints(0.5), \_
 CentimetersToPoints(20.4), \_
 CentimetersToPoints(1.2), \_
 CentimetersToPoints(20.4))
 FM2.Name = "RP200307243"
 FM2.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
 FM2.RelativeVerticalPosition = wdRelativeVerticalPositionPage
 FM2.Line.Weight = 0.25
 FM2.LockAnchor = True
 End If
 Set LM = oKz.Shapes("RP200307242")
 If LM Is Nothing Then
 'Die Länge des Striches (Lochmarke) beträgt 0,9 - 0,5 = 0,4 cm
 Set LM = oKz.Shapes.AddLine(CentimetersToPoints(0.5), \_
 CentimetersToPoints(14.85), \_
 CentimetersToPoints(0.9), \_
 CentimetersToPoints(14.85))
 LM.Name = "RP200307242"
 LM.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
 LM.RelativeVerticalPosition = wdRelativeVerticalPositionPage
 LM.Line.Weight = 0.25
 LM.LockAnchor = True
 End If
 ActiveWindow.View = savEnv
End Sub

Gruß
Franz

3

Sehr schönm danke dir o.w.T.