VBA Word

Falt- und Lochmarken nach DIN5008 setzen:
Word-Version: 2003
Die Markierungen werden über der Kopfzeile eingefügt und können damit bei der Bearbeitung des Dokumentinhaltes nicht versehentlich gelöscht werden.

Sub DIN5008_FaltUndLochMarkenSetzen()
    Dim objKopfzeile As Object
    Dim arrLines() As Variant
    Dim i, xLoc, yLoc As Integer

    Set objKopfzeile = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
    arrLines = Array(Array(8.7, 0.3, "FaltmarkeOben"), Array(19.2, 0.3, "FaltmarkeUnten"), Array(14.85, 0, "Lochmarke"))
    'Array(PositionZumOberenSeitenrand, PositionZumLinkenSeitenrand, ObjektName)

    For i = LBound(arrLines) To UBound(arrLines)
        On Error Resume Next
        If (objKopfzeile.Shapes.Item(arrLines(i)(2)) Is Nothing) Then
            With objKopfzeile.Shapes.AddLine(xLoc, yLoc, xLoc, yLoc)
                .Name = arrLines(i)(2)
                .Fill.Transparency = 0#
                .Line.Transparency = 0#
                .Line.Weight = 0.75
                .Line.Visible = msoTrue
                .Line.BeginArrowheadStyle = msoArrowheadNone
                .Line.EndArrowheadStyle = msoArrowheadNone
                .Line.DashStyle = msoLineSolid
                .Line.Style = msoLineSingle
                .Line.ForeColor.RGB = RGB(0, 0, 0)
                .Line.BackColor.RGB = RGB(255, 255, 255)
                .LockAspectRatio = msoFalse
                .Rotation = 0#
                .Height = 0#
                .Width = CentimetersToPoints(0.5)
                .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                .RelativeVerticalPosition = wdRelativeVerticalPositionPage
                .LockAnchor = False
                .LayoutInCell = False
                .Left = CentimetersToPoints(arrLines(i)(1))
                .Top = CentimetersToPoints(arrLines(i)(0))
                .WrapFormat.AllowOverlap = False
                .WrapFormat.Side = wdWrapBoth
                .WrapFormat.Type = 3
            End With
        End If
    Next i
End Sub
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-ShareAlike 3.0 License