HBHMZLS

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