Link4180neu

Funktion

Beschreibung

Hängt Titel e. Advz-Satzes an e. anderen Advz-Satz
Zeile 5430 - 5496

Code in WinIBW2 (Makro/VBScript)Sub

Sub Link4180Neu()
'name:        Link4180Neu
'replaces:        
'description:    after storing an Abvz's IDN to the clipboard we alter records by editing and providing them with
'            the before stored IDN in field 4180 the previous contents thus being deleted
'user:          Deutsche Nationalbibliothek's departments F1 and L1
'input:         none, as mentioned above the first step is to store the Advz's IDN
'return:        the Aa and Af sets with new relation to Abvz
'authors:         Roswitha Klein, Detlev Horst
'date:        2007-07-24
'version:        1.0.0.0    
On error resume next
Dim AbvzIDN            'variable storing IDN of Abvz record to be entered into AFx or Afx record
Dim WinA            'variable storing the active window object
Dim K4180            'variable storing the contents of field 4180
AbvzIDN = Application.ActiveWindow.Clipboard
Set WinA = Application.ActiveWindow
    if not WinA.Variable("scr") = "8A" then
        MsgBox "Ursache: Es liegt kein Datensatz in Vollanzeige vor!",vbOKonly + VbCritical,"Funktionsabbruch"
        exit sub
    end if
        Application.ActiveWindow.Command "k", False
        Application.ActiveWindow.Title.StartOfBuffer
        K4180 = Application.ActiveWindow.Title.Find("4180", True, False, True)
        if not K4180 = True then
                MsgBox "Ursache: Der Datensatz enthält kein Feld 4180",vbOKonly + VbCritical,"Funktionsabbruch"
                Application.ActiveWindow.SimulateIBWKey("FE")
                exit sub
        else
                Application.ActiveWindow.Title.Find ";", True, True, False
                Application.ActiveWindow.Title.WordLeft 1, False
                Application.ActiveWindow.Title.StartOfField True
                'Application.ActiveWindow.Title.WordRight 1, False
                Application.ActiveWindow.Title.InsertText "4180 " & AbvzIDN & " "
                'Application.ActiveWindow.SimulateIBWKey("FR")
        end if
End Sub

Code in WinIBW3 (Javascript)

Erforderliche Änderungen / Ergänzungen