Keresés

Új hozzászólás Aktív témák

  • Bazs87

    tag

    Sziasztok!

    VBS-ezgetek egy ideje, nagyon tetszik, hogy nem kell semmit telepíteni és pofátlanul egyszerűen használható, mindezt úgy, hogy még regexp lib is van hozzá.

    Egy hobbiprojekt kapcsán megkeresett egy ismerősöm, hogy vb8-ban kellene valamit alakítani, ráadásul excel VBA funkciók átvételéve.
    Mi és mekkora a különbség a vb és a vb.net közt? Egyértelmű leírást nem találtam eddig, igaz csak pár percet gugliztam.

    Úgy gondoltam, h ha már vb.net akkor ne a 8-assal szerencsétlenedjünk, hanem az épp aktuális visual studio verzióval.

    Vajon nagy fába vágom a fejszém ezzel? (sima "adatbázis"építés txt-ben és azokkal manipulálgatni, komolyabb dolgok elvileg nincsenek benne)

    Köszi előre is!
    Bazs87

  • Bazs87

    tag

    válasz martonx #2819 üzenetére

    köszönöm a választ!

    én inkább delphiznék, de nagyon csábító, hogy a feladat nagyját elég lenne copyzni és otpimalizálni. Minden újraírni elég nagy favágás lenne valszeg. (excel funkciókat kellene átülteni egy programba és kicsit továbbokosítani)

    Mivel ismerős, akivel csinálom csak vb-ben van otthon, így csak ez marad, de akkor legalább ne a vb8-cal csináljuk...

    ideje lenne valamilyen naprakész rendszerrel is dolgozni, továbbá kizáró feltétel, hogy GUI is kell

  • Bazs87

    tag

    Sziasztok!

    A fórumot olvasva kedvet kaptam az excel vba-hoz. Olyan amatőr kérdésem lenne, hogy hogyan tudom visszakapni a felhasználó által aktuálisan kiválasztott cellát? És milyen változóban tudom az értéket kimenteni?

    A zárolt sor oszlopnál selectelnem kell, de elég idegesítő, h ugrál a kurzor. Az elején lementeném a végén pedig visszanavigálnék ugyanoda. Elméletem szerint így észre sem lehetne venni a működését.

    Netán hamvába holt ötlet?

    Köszi!
    Bazs87

    [ Szerkesztve ]

  • Bazs87

    tag

    válasz Bazs87 #2829 üzenetére

    megoldódott ActiveCell-string, az odavissza kapcsolgatás meg nem szép:D Imsertek esetleg jobb megoldást?

  • Bazs87

    tag

    válasz sztanozs #2831 üzenetére

    ActiveWindow.FreezePanes = False
    Range("F7").Select
    ActiveWindow.FreezePanes = True

    Ha 2D-s zárolást szeretnék(azért mert ha csak 1D-t csinálok kizárólag az első sor lehet valamilyen beteg ok miatt zárolva, viszont én az első x sort szeretném zárolni), akkor vmivel ki kell jelölnöm, hogy honnan zárjon és manuális megoldással ezt az odaklikkeléssel lehet elérni.
    Talán van valamilyen expert funkció, de sajnos én nem ismerem.
    Nyitott vagyok és érdeklődő ;)

    [ Szerkesztve ]

  • Bazs87

    tag

    válasz sztanozs #2834 üzenetére

    a gyakorlat meg az évek :)

    nekem ez konkrétan az első excel makróm:p

    köszi a tippet!

  • Bazs87

    tag

    Sziasztok!

    Érdekes problémával találtam magam szembe:

    Feladat:
    van egy laza 25ezer soros német-lengyel fordításom, ami egy programból (Siemens TIA Portal) lett exportálva. A "text"manipulálás után szeretném visszatölteni ezt. Persze az új verzió egy libből kikeresve lefordítja amit letud (szakmai szöveg, nem érdemes összekötni semmilyen értelmes fordítóval, max ha gálvölgyi show-t és elégedetlen ügyfelet akarunk)

    Megoldási elv(eddig):
    létrehoztam egy vbs ole kapcsolatot excellel. (ne kérdezzétek miért, nekem komfortosabb így, mint az excel makrófelületével dolgozni)
    A program megnyitja a szótár excelt és az A oszlop elemei lesznek a key-ek, B oszlop azonos sorainak elemei pedig az adatok.
    Excel becsuk, új doku kinyit és egy sima compare után beírogatom a lengyel verziót. Ezután elmentem és mindenki boldog....

    Probléma:
    a txt sorai és az excel cellák tartalma nem azonos szintaxúak -> tele vannak a cellákon belüli "értékek"/adatok sortöréssel.
    Erre felkészültem, ezért nem txt a szótár fájlom, hanem excel.
    A dictionary key eleme viszont vmiért ezeket nem veszi át.

    Másik perverzebb ötletem az lenne, hogy még excelben helyettesíteni kell a vbcrln karaktereket valamilyen egyéb karakterre v láncra amit a mod végén visszahelyettesítenék (és ugye nincs a szövegben persze), de ugye ez plusz munka és nem vagyok túl szorgalmas ilyen fronton.
    Szeretek tanulni a hibámból, mert minden bizonyára elvi hibám van.
    Kérésre rendelkezésetekre tudom bocsátani az adatokat is, a kód így fest:

    xlsx_dict = "U:\6_798\Translate\v01\pl.xlsx"
    xlsx_trgt = "U:\6_798\Translate\v01\TIAProjectTexts_mod.xlsx"

    Set fso = CreateObject( "Scripting.FileSystemObject" )
    Set szotar = CreateObject("Scripting.Dictionary")

    Set objExcel = CreateObject("Excel.Application")

    if not fso.FileExists(xlsx_dict) then
    MsgBox xlsx_dict + " nicht gefunden"
    WScript.Quit()
    end if

    if not fso.FileExists(xlsx_trgt) then
    MsgBox xlsx_trgt + " nicht gefunden"
    WScript.Quit()
    end if

    objExcel.WorkBooks.Open xlsx_dict
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

    'dict aufladen
    for i=1 to 532
    tmp1 = cStr(objSheet.Cells(i,1).Value)
    tmp2 = cStr(objSheet.Cells(i,2).Value)

    if not szotar.exists(tmp1) then
    szotar.add tmp1, tmp2
    else
    'MsgBox "Problem mit key: " + tmp1
    end if
    next

    objExcel.ActiveWorkbook.Save
    objExcel.ActiveWorkbook.Close


    objExcel.WorkBooks.Open xlsx_trgt
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

    ' Übersetzen
    for i=2 to 24257
    dtext = objSheet.Cells(i,5).Value
    if szotar.exists(dtext) then
    objSheet.Cells(i,6).Value = szotar(dtext)
    else
    '
    end if
    next

    objExcel.ActiveWorkbook.Save
    objExcel.ActiveWorkbook.Close


    objExcel.Application.Quit

    Set objSheet = nothing
    set objExcel = nothing
    Set szotar = nothing
    Set fso = nothing

    msgBox "Fertig"

    Köszönöm az esetleges ötleteket!
    Követem a fórumot és öröm olvasni a profi megoldásaitokat!

  • Bazs87

    tag

    válasz Bazs87 #2869 üzenetére

    RITKÁN, de van hogy a lustaság nem kifizetődő

    így már a tesztejim szerint működik:

    xlsx_dict = "U:\6_798\Translate\v01\pl.xlsx"
    xlsx_trgt = "U:\6_798\Translate\v01\TIAProjectTexts_mod.xlsx"

    Set fso = CreateObject( "Scripting.FileSystemObject" )
    Set wobu = CreateObject("Scripting.Dictionary")


    Set objExcel = CreateObject("Excel.Application")

    if not fso.FileExists(xlsx_dict) then
    MsgBox xlsx_dict + " nicht gefunden"
    WScript.Quit()
    end if

    if not fso.FileExists(xlsx_trgt) then
    MsgBox xlsx_trgt + " nicht gefunden"
    WScript.Quit()
    end if

    objExcel.WorkBooks.Open xlsx_dict
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

    'dict aufladen
    for i=1 to 532
    tmp1 = cStr(objSheet.Cells(i,1).Value)
    tmp2 = cStr(objSheet.Cells(i,2).Value)

    tmp1 = Replace(tmp1,vbcrln,"</\>")
    tmp2 = Replace(tmp2,vbcrln,"</\>")

    if not wobu.exists(tmp1) then
    wobu.add tmp1, tmp2
    else
    'MsgBox "Problem mit key: " + tmp1
    end if
    next

    objExcel.ActiveWorkbook.Save
    objExcel.ActiveWorkbook.Close


    objExcel.WorkBooks.Open xlsx_trgt
    Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

    'Übersetzen
    for i=2 to 24257
    dtext = objSheet.Cells(i,5).Value

    dtext = Replace(dtext,vbcrln,"</\>")

    if wobu.exists(dtext) then
    tmp = Replace(wobu(dtext),"</\>",vbcrln)
    objSheet.Cells(i,6).Value = tmp
    else
    '
    end if
    next

    objExcel.ActiveWorkbook.Save
    objExcel.ActiveWorkbook.Close


    objExcel.Application.Quit

    Set objSheet = nothing
    set objExcel = nothing
    Set wobu = nothing
    Set fso = nothing

    msgBox "Fertig"

  • Bazs87

    tag

    Sziasztok!

    LibreOffice Calc-ot szeretnék vbs-ből manipulálni. Minden fut gond és működik, egyetlen problémám a sheet kiválasztása. Próbáltam több különböző parancsot (index szerint, megnevezés szerint), de sajnos egyik sem működik. Először meg kell nyitnom a fájlt, aminek az activesheet-jét átveszi, emiatt viszont a második megnyitott fájl már írásvédett lesz és az általam generált bagatell módosításokat nem tudom átvenni. (le tudnám menteni más néven, vagyis meg tudnám kerülni ezt a probémát, de nem ez a cél, szeretnék egy elegáns megoldást találni erre)

    Mivel a mahinálni kívánt fájl egy nagyon buta, de rendesen levédett fájl, ezért gondoltam arra is, hogy ott lehet a kutya elásva. A megoldásom viszont a teljesen sima új tesztcélra generált fájlt sem tudta az elvárásoknak megfelelően kezelni.
    Remélem valaki találkozott már ezzel a problémával.
    Köszönöm előre is!

    class timecnt
    dim st, et, ps, nwt, uswt, swt
    end class

    dim list(9)

    ' arrayclass deklaralas
    for i=0 to 9
    set list(i) = new timecnt
    next

    ' adatok kiolvasasa

    '----------------------------------------------------------------------------------------
    'http://www.oooforum.de/viewtopic.php?t=44190

    Set objServiceManager = WScript.CreateObject("com.sun.star.ServiceManager")
    Set StarDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")

    cURL = "file:///D:\BR\netzlaufwerk\NFO\vbs\libre_officemuster\test\test.ods"

    set oDoc = StarDesktop.loadComponentFromURL( cURL, "_blank", 0, Array() )
    set oSheet = oDoc.CurrentController.ActiveSheet

    'egyeb nem mukodo megoldasok
    'set oSheet = oDoc.getSheets().getByName( "Tabelle1" )
    'set oSheets = oDoc.getSheets()
    'set oSheet = oSheets.getByIndex(0)
    '----------------------------------------------------------------------------------------

    call librecalc_read

    wknd = false

    ' szamitasok elvegzese
    for i=0 to 9
    with list(i)
    sh = CutLeft ( .st, ":" )
    sm = CutRight( .st, ":" )
    eh = CutLeft ( .et, ":" )
    em = CutRight( .et, ":" )

    wtime = worktime_count(sh, sm, eh, em, .ps)
    if not wknd then
    if wtime<=8 then
    .nwt = wtime
    else
    .nwt = 8
    .uswt = wtime-8
    .swt = 0
    end if
    else
    .nwt = 0
    .uswt = 0
    .swt = wtime
    end if
    end with
    next

    ' adatok kiirasa
    call librecalc_write

    erase list

    '----------------------------------------------------------------------------------------
    set oSheet = nothing
    set oDoc = nothing
    Set StarDesktop = nothing
    Set objServiceManager = nothing
    '----------------------------------------------------------------------------------------

    MsgBox "process is done"



    function worktime_count(starth, startm, endh, endm, pause)
    'msgbox starth + " " + startm + "" + endh + " " + endm + " " + pause
    worktime_count = cInt(endh) + cInt(endm) / 60 - cInt(starth) - cInt(startm)/60
    if pause <> "" then worktime_count = worktime_count - cInt(pause) / 60
    end function

    function CutLeft(txt, sym)
    if txt<>"" then
    s_e = inStr( txt, sym )-1
    CutLeft = left ( txt, s_e)
    end if
    end function

    function CutRight(txt, sym)
    if txt<>"" then
    s_a = inStr(txt, sym)
    CutRight = right(txt, len(txt) - s_a)
    end if
    end function

    sub librecalc_read()
    for i = 0 to 9
    list(i).st = oSheet.getCellByPosition( 1, 15 + i ).String 'B16
    list(i).et = oSheet.getCellByPosition( 2, 15 + i ).String 'C16
    list(i).ps = oSheet.getCellByPosition( 6, 15 + i ).String 'G16
    next
    end sub

    sub librecalc_write()
    for i=0 to 9
    with list(i)
    if .nwt<>0 then
    oSheet.getCellByPosition( 3, 15 + i ).Value = .nwt 'D16
    end if
    if .uswt<>0 then
    oSheet.getCellByPosition( 4, 15 + i ).Value = .uswt 'E16
    end if
    if .swt<>0 then
    oSheet.getCellByPosition( 5, 15 + i ).Value = .swt 'F16
    end if
    end with
    next
    end sub

  • Bazs87

    tag

    válasz Vladek83 #2878 üzenetére

    a probléma megkerülése nem segít esetleg?

    amíg az egyik fut deaktiválod a másik kódrészletet így keresztreteszelést létrehozva. Netán az textbox objektet "disable"-re állítod, ha van ilyen funkciója, miután pedig lefutott a kép manipuláció újra enabled. Tudom nem szép megoldás, de sajnos jobb ötletem nincs. VB6-ban dolgozol?

  • Bazs87

    tag

    válasz szatocs1981 #2898 üzenetére

    a szöveges fájlnak mindegy mi a kiterjesztése, csak a meghíváskor azt írd be.

    ha előtte valamit manipulálsz benne:
    Új sor : text + vbNewLine
    ha nem szeretnél új sort értelemszerűen nem írod bele.

    ha csak megnyitod írásra: write/writeline

    2 Script 2 külön fájlba ír? egyik csv másik txt? Ha nem akkor a szinkronizáció gondot okozhat.

    A szöveges fájl meghívása...
    [link] 24. oldal

    ha kérdésed van állok rendelkezésedre

    [ Szerkesztve ]

  • Bazs87

    tag

    Sziasztok!

    Talán él még valaki, aki a témával foglalkozik :)

    A következő problémában szeretném az esetleges segítségeteket kérni:

    Mintát szeretnék kérni egy 4*4-es mátrix invertálásához.
    Valaki csinált már esetleg hasonlót?

Új hozzászólás Aktív témák