Keresés

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

  • Ezt kifejtenéd kicsit bővebben? Mert én jelenleg ilyesmin gondolkodom, de ez nem túl szép megoldás:

    If (Weekday(Now(), vbMonday) = 1) Then
    else if = 2 then dateadd (valamennyi)
    else if = 3 stb...

    De mind az 5 napra külön elseif-et írni nem tűnik valami jó megoldásnak.

    Szerintem elég egy If, ha a pénteket vesszük bázisnak, és jól értelmeztem az eddigieket, azaz február 9-15. között kell március 1-jét kihozni. Ha az az egy If nincs, akkor is csak péntekenként ugrana +1 hetet. Excel-VBA-ban valahogy így:

    Dim fri%, add%, d1 As Date, d2 As Date
    fri = Weekday(Now, vbFriday)
    add = 14
    If fri <> 1 Then add = add + 8 - fri
    d1 = Now
    d2 = DateAdd("d", add, d1)
    MsgBox d2

  • Sziasztok!

    Próbálok CDO-val emailt küldeni, de valahogy nem akar működni.
    Mi lehet a gond?

    Sub Send_Result_MailSMTP( _
    ByRef p_FullName As String, _
    ByRef p_Dat As String)

    Dim cdoMail As Object
    Dim cdoConf As Object

    Dim Wb1 As Workbook
    Dim FilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim Flds As Variant

    Set Wb1 = ActiveWorkbook


    FilePath = "C:\Temp\"
    Filename = p_FullName

    Workbooks(OutputMon_F_Name).SaveAs Filename:=FilePath & Filename

    Set cdoMail = CreateObject("CDO.Message")
    Set cdoConf = CreateObject("CDO.Configuration")

    Set Flds = cdoConf.Fields
    With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = webmail.mycompany.local
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    '.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    '.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username"
    '.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
    '.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
    End With


    On Error Resume Next
    With cdoMail

    .From = "myname@email.hu"
    .To = "myname@email.hu"
    '.CC = SendMail_CC
    .Subject = "Monitoring - " & p_Dat
    .HtmlBody = "<!DOCTYPE html><html><body><p style=""font-family:'Lucida Consolas', monospace""><pre>" & _
    "A mellékelt táblázat a Sharepoint felületen rögzített Monitoring feladatok alapján készült.<br><br></body> </html>"

    .AddAttachments FilePath & Filename
    .Send
    End With

    Set cdoMail = Nothing
    Set cdoConf = Nothing
    Set Flds = Nothing
    End Sub

    1-2 ötlet:
    1. mintha nem volna a config hozzárendelve cdoMail objectedhez. Valami ilyesmit hiányolok:

    Set cdoMail.Configuration = cdoConf

    Amúgy és a továbblépéshez:
    - attachment nélkül megy?
    - próbáld ki a .Update beillesztését is még a config blokkjának a végén
    - ugye próba esetén már nem maradnak kommentben az autentikációs sorok

    Végül pedig: mit mond az Err? Lehetne mondjuk egy Goto címkés blokk az onerrornál, amiben érdemes megnézni, hogy mi az Err.Description

  • Sziasztok.
    Visual Studio Enterprise 2017-et használok. Megcsináltam a form-ot, kód is rendben nincs hiba. Viszont a program nem megy. Fut,de nem hajtja végre a feladatot. Mit csinálhatok rosszul? :(

    1000+1 ok lehet, ennyi infóból nem lehet megmondani, hol csúszik el a dolog szemantikailag. Azokból, hogy "form" és "feladat", arra tippelnék, hogy valami gombklikk vagy hasonló eseményre várnád, hogy egy adott kódrészlet meginduljon, de innentől bizonytalan, hogy mi is történik. Breakpointokkal, lépésenkénti debuggal kellene kezdeni.

  • Sziasztok,

    Olyan kérdésem lenne, hogy word alá lehet írni egy olyan makrót ami kiveszi a szövegből az ENTER-eket?
    Apukám szokott konvertálni valamilyen fájlból(talán pdf) e-könyv formátumba olvasmányokat és konvertáláskor bent hagyja az ENTER-eket és így szét van tördelve a szöveg.(gondolom a pdf és e-könyv formátum közé beiktat, vagy be tud iktatni egy *.doc formátumot is)
    Lehet nem teljesen így történik, de az biztos, hogy az ENTER-eket kell eltüntetni egy *.doc szövegből. :)
    Köszönöm előre is.

    Ehhez nem kell makró, elég egy ^p Replace. Szemléletesebben itt.

  • Sziasztok,

    Olvasgatás után arra jutottam, hogy kérnék egy kis segítséget... Van egy mappa, melyben van 50 db excel fájl. Ezek első munkafüzetén lévő adatokat (azonos formátumuk van) kellene egy közös excel munkalapra másolni.

    Alapvetően ez elkészült. Ott vesztettem el a fonalat, hogy az 50 fájl jelszóval védett. Minden fájl neve fix, a hozzá tartozó jelszó is. (minden hónapban össze kell ezeket fűzni).
    Ötletem a következő volt:
    1. bejárom a mappát, mely az 50 fájl nevét tartalmazza.
    2. megnyitás nélkül kiolvasom a fájl nevét/elérési utat (ezzel nem boldogultam), melyből meghatározom a fájl nevét.
    3. Megnyitom a fájl név - jelszó párost tartalmazó fájlt, és ott az első oszlopban megkeresem azt. Kiolvasom a mellette lévő oszlopból a hozzá tartozó jelszót. És ekkor azt a fájlt, ahol az előbb járt a feldolgozás, megnyitom a jelszó beírásával, és indulhat a másolás.

    Van esetleg ettől egyszerűbb megoldás, hogy jelszóval védett fájlból a tartalmat átmásoljam egy közös fájlba?

    Bocsánat, ha nagyon alap dolgot kérdeztem, sok mindent kell még megnéznem ezen a területen :F

    Excelben, VBA-val akarod ezt megoldani? Vagy valamilyen dotnetes nyelven inkább?

    Ha előbbi, akkor nem igazán látom, mi akasztott meg, ha már a feladat lényege elkészült. A 2-es ponthoz segíthet például ez:

    Option Base 1
    Function GetFileNames(directoryPath As String) As String()
    Dim namepathlist() As String
    Dim fshelper As Object
    Dim targetdir As Object
    Dim filecnt%, i%
    On Error Resume Next

    Set fshelper = CreateObject("Scripting.FileSystemObject")
    Set targetdir = fshelper.GetFolder(directoryPath)
    filecnt = targetdir.Files.Count
    If filecnt > 0 Then
    ReDim namepathlist(filecnt, 2)
    i = 1
    For Each f In targetdir.Files
    namepathlist(i, 1) = f.Name
    namepathlist(i, 2) = f.path
    i = i + 1
    Next
    End If
    On Error GoTo 0
    GetFileNames = namepathlist
    End Function

    Persze nem biztos, hogy érdemes külön függvényt írni csak ezért, és akár a Dir() függvényre is rá lehet nézni, aztán amelyik egyszerűbb, azzal menni tovább.

    Ami meg a 3. pontot illeti, ezt nem így csinálnám, de ennek csak praktikus okai vannak. Mielőtt az egész 50-es iteráció elindul, azelőtt kellene beolvasni változókba az összes előírt fájlnevet és jelszót, ezután jöhet a könyvtár aktuális tartalma, lásd fent, és végül egy olyan iteráció, ami az aktuális listán megy végig, és ha talál az adott példányhoz jelszót, akkor elvégzi a már kész lépéseket.

  • Sziasztok!

    Hyperlinkekkel van gondom, mergelt cellákon van beállítva, ha megváltoztatom a hyperlink-et, ha fölé viszem az egeret a régi hivatkozást mutatja (a szürke kis popupban) és a VBA kód is a régi hivatkozást mutatja az első cellára a többire pedig az újat.
    Ezt nem minden esetben csinálja, ez mi a fene lehet, vagy hogy tudnám azt megoldani, ha módosítom a hyperlinket az mindegyik mergelt cellájában az legyen?

    Pontosan nem jöttem rá.

    Köszi előre is!

    Ez félig bugnak tűnik, de található rá magyarázat. A szürke popup kivételével sikerült is reprodukálnom. A cellához tartozó link nem egy egyedi string érték, hanem egy collection. Két cella egyesítésekor az első cella linkje marad csak meg, a többié elveszik, eddig rendben. Ha ezután módosítod a grafikus nézetben a linket, akkor a háttérben egy .Add() függvényt használhat az Excel. Ez csak tipp, de eléggé gyanús. Mi történik ezután: az egyesített cella első részcellájában KETTŐ link lesz, az (1) indexen a régi, a (2) indexen az új. A többi részcellában eddig semmi nem volt, ezért oda az (1) indexen az új kerül.

    Tegyük fel, hogy az A oszlopban vannak a linkes cellák, némelyik egyesített. Ekkor egy teljeskörű teszthez például bevethető ez, most 4 sort feltételezve:

    Dim rowcount%
    rowcount = 4

    For i = 1 To rowcount
    If Range("A1").Offset(i - 1, 0).Hyperlinks.Count > 0 Then
    For j = 1 To Range("A1").Offset(i - 1, 0).Hyperlinks.Count
    MsgBox Range("A1").Offset(i - 1, 0).Hyperlinks(j).Address, vbOKOnly, _
    Range("A1").Offset(i - 1, 0).AddressLocal & ", index: " & j & _
    ", full count: " & Range("A1").Offset(i - 1, 0).Hyperlinks.Count
    Next
    End If
    Next

    Ha a problémádat jól leírja a fenti, és VBA-ban kell feldolgoznod a linkeket, akkor a Count tulajdonságot kell indexként használni, és így mindig a legutoljára beállított linket olvassa a kód.

    Persze van egy olyan olvasata is ennek az enyhén bugos helyzetnek, hogy formailag szép dolog az egyesített cella, de amint a tábla célja nem a külsőségekről szól, hanem valamilyen automatizált feldolgozásról, ott részemről csak felesleges nyűg.

  • Köszi meglesem majd.

    Végül rekorddal oldottam meg a bináris fához kevés voltam, meg időm sem volt rá sok, viszont lett lassú.

    Most egy olyan problémám van, hogy vannak bizonyos cellák amikre van beállítva hyperlink, és azt kellene ellenőriznem, hogy ezek a hyperlinkek valós fájlokra vannak-e beállítva (mondjuk kitöröltek 1 fájlt, de a hivatkozás megmaradt). Sajna a fájlok átnevezése jelenleg nem kivitelezhető.

    Ami itt a gondom, hogy némelyik fájlban van szóköz, [] zárójelek stb.. tehát amikor lekérdezem a hyperlink-et akkor a hivatkozásban "konyvtar\valami%5d%20f.docx" formában kapom vissza. Ezzel mit lehet mókolni, hogy a rendes fájlnevet kapjam vissza?
    A hyperlinket így kérem le: Cells(3,3).Hyperlinks(1).Address

    Köszi a válaszokat.

    Ez elég furcsa, efféle url encodingot automatikusan nem kellene kapnod, kipróbáltam saját fájlban is, simán benne hagyta a szóközöket. Van egyébként olyan beépített függvény Encodeurl néven, ami ilyen átalakításokat csinál, de a fordított irányról nem tudok (2013-assal bezárólag). Kerülő úton lehet megpróbálni, mondjuk cserékkel, lásd például itt.

  • Sziasztok!

    Olyan problémám lenne, hogy van egy bitang sok adatot tartalmazó munkafüzetem több munkalappal.

    A problémám:
    Bizonyos gyümölcsök random előfordulhatnak egy munkalapon belül, és azt kell megvizsgálnom, ha valamelyik gyümölcsnél szerepel az X akkor annak a gyümölcsnek van-e legalább 1 olyan esete ahol nem X szerepel, ha nincs akkor hibás.

    Hogy lehetne ezt úgy megoldani, hogy ne 10 perc legyen a futtatása, szóval minél egyszerűbb de hatékony megoldás kellene?

    Konkrét megoldást nem kérek, csak valami nyomot amin elindulhatnék.

    Köszi előre is!

    Kipróbáltam két oszloppal, 10 ezer sorban, de nehezítésképpen úgy, hogy az első 5000-ben csak X volt mindenhol, és az egyik gyümölcsnél később is csak X volt. Nem is igazán mérhető a futásidő, fél másodpercnél is kevesebb. Tehát vagy rengeteg oszlopod lehet, vagy sok százezer sor, vagy még egyéb tényezők. De a 10 perc mindenképpen túlzás.

    Tudom h nem kértél konkrétumot, de csak bemásolok ide egy rövidke scriptet, egyszerű megközelítésben, valami támpontot adhat azért.

    Option Base 1

    Sub t()

    Dim gimilc()
    Dim vannemX()
    Dim n%, i%
    Dim g As String

    n = 1
    ReDim Preserve gimilc(n)
    ReDim Preserve vannemX(n)

    gimilc(1) = Cells(2, 1).Value
    vannemX(1) = False
    If Cells(2, 2).Value <> "X" Then
    vannemX(1) = True
    End If
    For i = 3 To 10000
    g = Cells(i, 1).Value

    Dim gindex%
    gindex = -1
    For j = 1 To n
    If gimilc(j) = g Then
    gindex = j
    Exit For
    End If
    Next

    If gindex = -1 Then
    n = n + 1
    ReDim Preserve gimilc(n)
    ReDim Preserve vannemX(n)
    gimilc(n) = g
    vannemX(n) = False
    If Cells(i, 2).Value <> "X" Then vannemX(n) = True
    Else
    If vannemX(gindex) = False Then
    If Cells(i, 2).Value <> "X" Then vannemX(gindex) = True
    End If
    End If
    Next

    End Sub

  • Szia Zalán!

    Igen ez lesz nekem a megoldás. Valóban be kell szúrni egy következő Pararaph-t.

    Most már csak annyi maradt a problémámból, hogy a feladat:
    1. sor szöveg
    2. sor beillesztett kép
    3. sor szöveg.

    Jelenleg ha beszúrom a képet, akkor a margók 1,1 poziciójába teszi be és felülírja az első sort.

    Hogyan tudok úgy beszúrni egy képet, hogy megadom, hogy melyik X,Y koordinátára helyezze el a képet,
    vagyis, a RANGE-en belül hova teyge.

    Köszi: Gábor

    Valami ilyesmire lesz akkor szükség. Ez most C#, a szélesség, fájlnév stb. átírandó, de a lényeg ugyanaz.

    wp.Range.Text = "line1";
    wp.Range.Paragraphs.Add();

    Shape shape = wd.Shapes.AddShape(1, 0, 0, 200, 100);
    shape.Fill.UserPicture(@"C:\kep.png");
    InlineShape inlineShape = shape.ConvertToInlineShape();
    inlineShape.Range.Cut();
    wp.Range.Paste();
    wp.Range.Paragraphs.Add();

    wp = wd.Content.Paragraphs.Add();
    wp.Range.Text = "Line2";

    Lehet még variálni ezeket a range meg paragraph dolgokat, hozzáfűzéssel új object helyett stb. biztos van sokkal elegánsabb út is, ha valaki rászánja az időt. Ami ezeknél fontosabb, hogy ha ezután elmentjük a doksit, egy rakás referencia marad még lógva, azokat a COM dolgokat is illik eltakarítani. Tippek bővebben itt.

  • Sziasztok!

    Segítségeteket szeretném kérni.

    Visual Studio 2017 Visual Basic - Microsoft.Office.Interop.Word extension

    Feladat: VB-ből létrehozott Word dokumentumba beírni:

    1 sor tetszőleges szöveg
    2 sor vágólapról bemásolt vonalkód
    3. sor tetszőleges szöveg.

    Eddig a Range.Text értéket írtam, de azt vettem észre, hogy ha az első sor után beillesztem a vágólap tartalmát, akkor felülírja a Range.Text előző értékét.

    Lehet több Range.Text-et kezelni?

    Tudtok esetleg olyan oldalt, ahol ehhez hasonló példákat lehetne találni:

    Private Function wordbeir()
    Dim wa As Microsoft.Office.Interop.Word.Application
    Dim wd As Microsoft.Office.Interop.Word.Document
    Dim wp As Microsoft.Office.Interop.Word.Paragraph


    wa = CreateObject("Word.Application")
    wa.Visible = False

    wd = wa.Documents.Add
    wp = wd.Content.Paragraphs.Add
    wd.PageSetup.LeftMargin = 1
    wd.PageSetup.RightMargin = 1
    wd.PageSetup.TopMargin = 1
    wd.PageSetup.BottomMargin = 1


    wd.PageSetup.PageHeight = 141
    wd.PageSetup.PageWidth = 224
    wp.Range.Text = "This text will be d"


    AxStrokeScribe1.CopyToClipboard(80, 50)
    wp.Range.Text = "Foo" & Chr(10) & Chr(11)

    wd.Range.Next()

    wd.Range.Paste()

    'wd.Range.InlineShapes.AddPicture("c:\cimkezo\vkod.jpg")

    ' itt próbálkoznék azzal, hogy beíllesztek egy külső képfájlt,



    wd.SaveAs("c:\cimkezo\cimke.docx")
    wa.Quit()
    End Function

    Az első tipp látatlanban is, hogy ugyanannak a range objectnek a szövegét íratod át a második alkalommal is. Ha a beírandó részek különállóak, akkor például meg lehetne ismételni a Paragrahps.Add() hívást.

    wp = wd.Content.Paragraphs.Add
    wp.Range.Text = "This text will be d"
    ...
    wp = wd.Content.Paragraphs.Add
    wp.Range.Text = "Foo" & Chr(10) & Chr(11)

  • Nem tudom teljesen reprodukálni az alaphelyzetet, de van itt egy egyszerű megoldás. Új standard modulba beírtam ezt:

    Sub FormatZoleehDates()
    For Each c In ActiveSheet.UsedRange.Cells
    c.NumberFormat = "m/d/yyyy"
    Next
    End Sub

    Nyilván a numberformatot lehet még alakítani. Kipróbálás: beírtam pár dátumot egy tartományba, átkapcsoltam custom -> general beállításra a formatot, utána kijelöltem, és ráküldtem a fentit.

    Csak egy kis kiegészítés, mert a szerk. idő lejárt: nyilván más esetekben célszerűbb lehet inkább Selection.Cells kollekcióra futtatni a ciklust, a példában egy töküres lapon csak a dátumos cellák szerepeltek, ezért volt mindegy.

  • Sziasztok!

    Egy egyszerűnek tűnő, de számomra eddig megoldhatatlan feladatban szeretnék segítséget kérni. Adott egy letöltött excel fájl, amelynek egyik oszlopában ilyen formátumban szerepelnek a dátumok:
    2018.04.17. 17:30
    2018.04.17. 16:59
    2018.04.17. 14:54
    2018.04.17. 14:09
    A cellák formátuma "Általános", amely F2 és Enter után átalakul a kívánt dátumformátumra "éééé.hh.nn ó:pp". Ezt szeretném automatizálni egy makróval, átolvasva a fórumokat 3 megoldást találtam, de mindegyik ugyanott vérzik el.
    Vagyis, a makrófelvételnél minden tökéletesen működik, de ha a rögzített makrót futtatom az eredeti fájlon hibaüzenet nélkül lefutnak a makrók, de a cellák formátuma nem változik maradnak "Általános". :W
    A megoldásaim:
    1. Egy üres cellába "1" írok, majd másolás és a dátumok kijelölése után "Speciális beillesztés" Szorzás.
    Sub Rögzítés1()
    '
    ' Rögzítés1 Makró
    ' Rögzítette: xy, dátum: 2018.04.17.
    '

    '
    Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).Select
    ActiveCell.FormulaR1C1 = "1"
    Selection.Copy
    Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count - 1, 1)).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    End Sub

    2. A tartomány kijelölése után a ". " cseréje " "-ra
    Sub Rögzítés2()
    '
    ' Rögzítés2 Makró
    ' Rögzítette: xy, dátum: 2018.04.17.
    '

    '
    Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)).Select
    Selection.Replace What:=". ", Replacement:=" ", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    End Sub

    3. A tartomány kijelölése után "Szövegből oszlopok"
    Sub Rögzítés3()
    '
    ' Rögzítés3 Makró
    ' Rögzítette: xy, dátum: 2018.04.17.
    '

    '
    Range(Cells(2, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)).Select
    Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    End Sub

    Tudjátok mi lehet a megoldás? Vagy írjak egy makrót a For Sendkeys F2 Enter Next parancsok felhasználásával?

    Köszi

    Nem tudom teljesen reprodukálni az alaphelyzetet, de van itt egy egyszerű megoldás. Új standard modulba beírtam ezt:

    Sub FormatZoleehDates()
    For Each c In ActiveSheet.UsedRange.Cells
    c.NumberFormat = "m/d/yyyy"
    Next
    End Sub

    Nyilván a numberformatot lehet még alakítani. Kipróbálás: beírtam pár dátumot egy tartományba, átkapcsoltam custom -> general beállításra a formatot, utána kijelöltem, és ráküldtem a fentit.

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