Beiträge: 444
Themen: 100
Danke erhalten: 19 in 18 Posts
Danke gesagt: 175
Registriert seit: 17.03.2013
Hallo Norre und Martin,
danke für die zusätzlichen Hinweise, werde ich morgen testen und Rückmeldung geben
•
Beiträge: 1.437
Themen: 11
Danke erhalten: 273 in 232 Posts
Danke gesagt: 26
Registriert seit: 24.03.2012
23.09.2019, 22:57
(Dieser Beitrag wurde zuletzt bearbeitet: 23.09.2019, 22:59 von koter.)
Hallo Günther,
Das Folgende Makro löscht alle Pixel-Zeilen, die von einer Maske berührt werden.
Du musst die Maske also nicht über die gesamte Breite des Bildes aufziehen.
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
Der Rest wird nach oben gezogen (wie Text in einer Textverarbeitung wenn man Zeilen löscht).
Vielleicht kannst Du damit etwas anfangen.
Gruß
Koter
Beiträge: 444
Themen: 100
Danke erhalten: 19 in 18 Posts
Danke gesagt: 175
Registriert seit: 17.03.2013
Hallo Koter,
1000 Dank für das Makro, funktioniert genau so, wie ich es mir vorgestellt habe
Viele Grüße - Günther
•