Bildteilbereiche ausschneiden

Code:
Sub KillPixelzeilen()

    Dim D As Document

    Dim M As New Mask

    Dim BL As Layer

    Dim MX As Long, MY As Long, MH As Long, MB As Long

    Set D = ActiveDocument

    

    If D.Mask.IsEmpty Then

        MsgBox "Keine Maske!", vbCritical, "Fehler"

        Exit Sub

    Else

        Set M = D.Mask

        Set BL = D.Background.ConvertToLayer

    End If

    With M

        MX = .PositionX

        MY = .PositionY

        MH = .SizeHeight

        MB = .SizeWidth

        .SetSize D.SizeWidth, MY

        .PositionY = 0

        .PositionX = 0

    End With

    D.Layers.Add "Oben", , , pntCopySelection

    BL.CreateMask

    M.SetSize D.SizeWidth, D.SizeHeight - MY - MH

    D.Layers.Add "Unten", , , pntCopySelection

    D.Layers("Unten").PositionY = MY

    BL.Delete

    D.Crop 0, 0, D.SizeWidth, D.Layers("Unten").PositionY + D.Layers("Unten").SizeHeight

    D.Layers.Merge

End Sub