KKopiert Ex.-/SE-Daten aus e. Aao-Satz
Zeile 3105 - 3159
Sub KopiereDBLaltEx()
On error resume next
Dim strDBLALTEX
Dim bNoMore5530
'Vollanzeige erzwingen und speichern
if not Application.ActiveWindow.Variable("scr") = "8A" then
Fehler "Es liegt kein Datensatz in Vollanzeige vor!"
exit sub
end if
Application.ActiveWindow.Command "k", False
Application.ActiveWindow.Title.StartOfBuffer False
'Kopie 5530
bNoMore5530 = FALSE
Application.ActiveWindow.Title.Find "5530" , true , false , true
Do until (bNoMore5530 or a >=5)
if (Application.ActiveWindow.Title.GetTag = "5530") then
Application.ActiveWindow.Title.StartOfField False
Application.ActiveWindow.Title.EndOfField True
strDBLALTEX = strDBLALTEX & vbcr & Application.ActiveWindow.Title.GetSelection()
else
bNoMore5530 = TRUE
strDBLALTEX = strDBLALTEX & vbcr & vbcr & "7001 o" & vbcr
end if
Application.ActiveWindow.Title.Linedown
loop
' Application.ActiveWindow.Title.StartOfBuffer False
if (Application.ActiveWindow.Title.Find("7100", true , false , true)) then
Application.ActiveWindow.Title.StartOfField False
Application.ActiveWindow.Title.EndOfField True
strDBLALTEX = strDBLALTEX & Application.ActiveWindow.Title.GetSelection() & vbcr
'msgbox strDBLALTEX
end if
Application.ActiveWindow.Title.StartOfBuffer False
'Kopie 7109
if (Application.ActiveWindow.Title.Find("7109 ", true , false , true)) then
Application.ActiveWindow.Title.StartOfField False
Application.ActiveWindow.Title.EndOfField True
strDBLALTEX = strDBLALTEX & Application.ActiveWindow.Title.GetSelection()
'msgbox strDBLALTEX
end if
Application.ActiveWindow.SimulateIBWKey "FE"
msgbox strDBLALTEX
strDBLALTEX = Application.PicaToLatin(strDBLALTEX)
'msgbox strDBLALTEX
Application.ActiveWindow.ClipBoard = strDBLALTEX
End Sub