~ Falzmarken als Makro einfügen - by iceblockx ~

Diese Seite verwendet Cookies. Durch die Nutzung unserer Seite erklären Sie sich damit einverstanden, dass wir Cookies setzen. Weitere Informationen

  • ~ Falzmarken als Makro einfügen - by iceblockx ~

    Zunächst müsst Ihr die Datei/Dokumentvorlage "normal.dot" finden und diese direkt unter Word öffnen.

    Der Speicherort kann dabei varieren. Folgende drei Ordner bitte durchsuchen:
    • Installierte Vorlagen:
    C:\Programme\Microsoft Office\Templates\1031
    • Pfad der Benutzervorlagen (Standardordner):
    C:\Dokumente und Einstellungen\<Benutzername>\Anwendungsdaten\Microsoft\Vorlagen
    • Pfad der Arbeitsgruppenvorlagen:
    <Nicht standardmäßig gesetzt>

    Eventuell empfiehlt sich, die "normal.dot" vorher zu sichern!Für eine Rückgängigmachung, falls erforderlich!

    Um die folgenden Lösungen allgemein verfügbar zu machen, gehe dabei bitte wie folgt vor:

    1.Öffne die Standardvorlage mit dem Namen Normal.dot explizit über den Word-Dialog Datei - Öffnen....
    2.Wechseln mit der Tastenkombination [Alt + F11] in die VBA-Umgebung.
    3.Im VBA-Editor glücklich angekommen, wähle ausgehend vom Hauptmenü den Befehl Einfügen - Modul.
    4.Kopiere eines der folgenden Beispiele (oder gleich alle) in das leere Fenster des Moduls.
    5.Speichere die Normal.dot und schliesse MS Word.
    6.Nachdem Du MS Word neu startest, wähle ausgehend vom Word-Hauptmenü den Befehl Extras - Makro - Makros....
    7.Markiere in der Liste eines der folgenden Makros: FaltmarkeEinfügen, FaltUndLochmarkeEinfügen, FaltmarkeEinfügenNurErsteSeite, FaltUndLochmarkeEinfügenNurErsteSeite oder AlleMarkenLoeschen und betätige dann die Schaltfläche Ausführen.
    8.Drucke schliesslich zu Testzwecken ein kleines Word-Dokument aus.

    Faltmarke auf jeder Seite des gedruckten Dokumentes

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

    Falt- und Lochmarke auf jeder Seite des gedruckten Dokumentes

    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

    Faltmarke ausschliesslich auf der ersten Seite des gedruckten Dokumentes

    Sub FaltmarkeEinfügenNurErsteSeite()
    'Die Länge des Striches beträgt 0,9 - 0,5 = 0,4 cm
    Dim oKz As HeaderFooter, FM As Shape
    savEnv = ActiveWindow.View
    Rand = ActiveDocument.Sections(1).PageSetup.LeftMargin
    ActiveDocument.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True
    Set oKz = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
    On Error Resume Next
    Set FM = oKz.Shapes("RP200307241")
    If Not FM Is Nothing Then Exit Sub
    Set FM = oKz.Shapes.AddLine(CentimetersToPoints(0.5) - Rand, _
    CentimetersToPoints(10.4), _
    CentimetersToPoints(0.9) - Rand, _
    CentimetersToPoints(10.4), oKz.Range)
    FM.Name = "RP200307241"
    FM.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    FM.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    FM.Line.Weight = 0.25
    FM.LockAnchor = True
    ActiveWindow.View = savEnv
    End Sub

    Falt- und Lochmarke ausschliesslich auf der ersten Seite des gedruckten Dokumentes

    Sub FaltUndLochmarkeEinfügenNurErsteSeite()
    Dim oKz As HeaderFooter, FM As Shape, LM As Shape
    savEnv = ActiveWindow.View
    Rand = ActiveDocument.Sections(1).PageSetup.LeftMargin
    ActiveDocument.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True
    Set oKz = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
    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) - Rand, _
    CentimetersToPoints(10.4), _
    CentimetersToPoints(1.2) - Rand, _
    CentimetersToPoints(10.4), oKz.Range)
    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) - Rand, _
    CentimetersToPoints(14.85), _
    CentimetersToPoints(0.9) - Rand, _
    CentimetersToPoints(14.85), oKz.Range)
    LM.Name = "RP200307242"
    LM.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    LM.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    LM.Line.Weight = 0.25
    LM.LockAnchor = True
    End If
    ActiveWindow.View = savEnv
    End Sub

    Alle Marken Löschen

    Sub AlleMarkenLoeschen()
    Dim oShape As Shape
    For i = 1 To 2
    For Each oShape In ActiveDocument.Sections(1).Headers(i).Shapes
    If InStr(oShape.Name, "RP20030724") = 1 Then oShape.Delete
    Next
    Next i
    End Sub


    Viel Spaß!