Seitenhistorie

Funktion

Beschreibung

Ändert Status in Titeldatensatz
Zeile 2028 - 2078

Code in WinIBW2 (Makro/VBScript)Sub

Sub Freigabe()
'************************************************    
On error resume next    
'Vollanzeige erzwingen
Set WinA = Application.ActiveWindow
    if not WinA.Variable("scr") = "8A" then
        Fehler "Es liegt kein Datensatz in Vollanzeige vor!"
        exit sub
    end if
        'Datensatz kopieren    
        CopyTitle = WinA.CopyTitle
        'msgbox Application.ActiveWindow.Variable("P3CLIP")
        'neue Instanz des Regular Expression Objektes erzeugen
        set RegEx0599 = New RegExp
        'zu suchendes Muster: 0599 xx-xx-xx : b
        'RegEx0599.Pattern = "0599 \d\d-\d\d-\d\d : b"
        'zu suchendes Muster ab 07.04.08
        RegEx0599.Pattern = "0599 \d\d-\d\d-\d\d : b|0599 \d\d-\d\d-\d\d : os"
        'Globale Suche über den gesamten Datensatz
        RegEx0599.Global = True
        'Groß- und Kleinschreibung ignorieren
        RegEx0599.IgnoreCase = True
        Set Matches = RegEx0599.Execute(CopyTitle)
                for each Match in Matches
                search0599b = Match.Value
                'Msg = Msg & "Match.Value = " & Match.Value & vbcrlf & "Match.Length = " & Match.Length & vbcrlf & "Matches.Count = " & Matches.Count & vbcrlf & "Match.FirstIndex = " & Match.FirstIndex
                'msgbox Msg
                'Datensatz editieren
                Application.ActiveWindow.Command "k", False
                'Match suchen und markieren
                Application.ActiveWindow.Title.Find search0599b, True, False, False
                Application.ActiveWindow.Title.EndOfField True
                Application.ActiveWindow.Title.DeleteSelection
                Application.ActiveWindow.Title.InsertText "0599 a"
                'Bug bei Replace: abhängig von Benutzerrechten bestimmte Felder nicht editierbar,
                'wenn der Cursor sich auf einem solchem Feld befindet läuft Replace nicht korrekt ab
                'Application.ActiveWindow.Title.Find search0599b, true, false, true
                'Match ersetzen
                'Application.ActiveWindow.Title.Replace("0599 a")
                next
               
                'keine Matches gefunden? Fehlermeldung und Funktionsabbruch
                if    search0599b = "" then
                    Fehler "Es existiert kein mit ""b"" codiertes Feld 0599," & vbcr & "eine Freigabe des Datensatzes ist nicht möglich!"
                    exit sub
                end if
                'Abspeichern (war aus Sicherheitsgründen zunächst noch auskommentiert)
                Application.ActiveWindow.SimulateIBWKey("FR")
End Sub

Code in WinIBW3 (Javascript)

...