Skip to end of metadata
Go to start of metadata

Funktion

Beschreibung

KKopiert Ex.-/SE-Daten aus e. Aao-Satz
Zeile 3105 - 3159

Code in WinIBW2 (Makro/VBScript)Sub

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

Code in WinIBW3 (Javascript)


Erforderliche Änderungen / Ergänzungen

  • No labels