Funktion
Beschreibung
Code in WinIBW2 (Makro/VBScript)
Sub HBHMZLS() On error resume next Dim InputLS, K4801, K5301, K7109, SearchK4700, SearchK5301, SearchK7001, c0 Set WinA = Application.ActiveWindow if not WinA.Variable("scr") = "8A" then Fehler "Es liegt kein Datensatz in Vollanzeige vor!" exit sub end if WinAct = WinA.CopyTitle K7001 = mid(WinAct, instr(WinAct,"7001 ")) K7001 = left(K7001, instr(K7001,vbcr)) 'msgbox K7001 If K7001 = "" then Msgbox "Keine Exemplardatensätze gefunden!" & vbExclamation Exit Sub End if InputLS = InputBox("Bitte geben Sie ein ""H"" für HLS, ein ""M"" für MLS oder ein ""Z"" für ZLS ein!", "Lesesaal-Eingabe", Input) If (InputLS = "H") or (InputLS = "h") then InputLS = "HLS" elseif (InputLS = "M") or (InputLS = "m") then InputLS = "MLS" elseif (InputLS = "Z") or (InputLS = "z") then InputLS = "ZLS" else Achtung "Sie haben kein ""H"", ""M"" oder ""Z"" eingegeben," & vbcrlf & "die Funktion wird abgebrochen!" exit sub end if K4801 = vbcr & "4801 " K5301 = vbcr & "5301 " K7109 = vbcr & "7109 !!" & InputLS & "!! ; " WinA.Command "k", False SearchK7001 = WinA.Title.StartOfBuffer SearchK7001 = WinA.Title.FindTag ("7001", 0, False, True) ArSearchK7001 = split(SearchK7001, " ") SelKey = len(ArSearchK7001(2)) 'msgbox Len(SearchK7001) & vbcrlf & ArSearchK7001(2) & vbcrlf & SelKey if SearchK7001 <> "" then WinA.Title.WordRight 2, true 'WinA.Title.DeleteSelection if SelKey = 1 then WinA.Title.EndOfField WinA.Title.InsertText "xp" & K4801 & K7109 elseif SelKey >= 2 then WinA.Title.EndOfField WinA.Title.InsertText K4801 & K7109 end if end if SearchK5301 = WinA.Title.StartOfBuffer SearchK5301 = WinA.Title.FindTag ("5301", 0, True, True) if SearchK5301 <> "" then WinA.Title.EndOfField Else WinA.Title.StartOfBuffer WinA.Title.FindTag "7109", 0, True, True WinA.Title.EndOfField WinA.Title.InsertText K5301 End if End Sub
Code in WinIBW3 (Javascript)
Erforderliche Änderungen / Ergänzungen
keine
Überblick
Inhalte