-
Fórumok
LOGOUT - lépj ki, lépj be!
LOGOUT reakciók Monologoszféra FototrendGAMEPOD - játék fórumok
PC játékok Konzol játékok MobiljátékokMobilarena - mobil fórumok
Okostelefonok Mobiltelefonok Okosórák Autó+mobil Üzlet és Szolgáltatások Mobilalkalmazások Tartozékok, egyebek Mobilarena blogokPROHARDVER! - hardver fórumok
Notebookok TV & Audió Digitális fényképezés Alaplapok, chipsetek, memóriák Processzorok, tuning Hűtés, házak, tápok, modding Videokártyák Monitorok Adattárolás Multimédia, életmód, 3D nyomtatás Nyomtatók, szkennerek Tabletek, E-bookok PC, mini PC, barebone, szerver Beviteli eszközök Egyéb hardverek PROHARDVER! BlogokIT café - infotech fórumok
Infotech Hálózat, szolgáltatók OS, alkalmazások SzoftverfejlesztésFÁRADT GŐZ - közösségi tér szinte bármiről
Tudomány, oktatás Sport, életmód, utazás, egészség Kultúra, művészet, média Gazdaság, jog Technika, hobbi, otthon Társadalom, közélet Egyéb Lokál PROHARDVER! interaktív
Új hozzászólás Aktív témák
-
Lokids
addikt
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 d2Köszi. Így jó.

-
Lokids
addikt
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 sorokVé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
Attachment nélkül sem megy, updatet is hozzáadtam, meg a config sort is. És persze nincs kommentezve az auth sem, csak már a nélkül is próbáltam.

De a legrosszabb, hogy semmi hibát nem dob. Végig fut, mintha nem lenne gond.
-
mdk01
addikt
-
Delila_1
veterán
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 FunctionPersze 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.
Szerkesztés: elnézést, Vertusnak szól,
Nálam a makrót tartalmazó füzet első lapján, az A oszlopban vannak a fájlnevek, kiterjesztéssel. Mellettük a B-ben a hozzájuk tartozó jelszavak.
Két helyen kell a makrót személyre szabnod. Az első az utvonal változó, a második a Match függvényes sor. Mindkettő végére tettem 3 db *-ot.Private Sub Megnyit()
Dim FN As String, sor As Variant, jelszo
Const utvonal As String = "F:\Eadat\Próba\" '***
ChDir utvonal
FN = Dir(utvonal & "*.xlsx")
Do While FN <> ""
On Error Resume Next
sor = Application.Match(FN, Sheets(1).Columns(1), 0) '***
If sor = vbError Then
On Error GoTo 0
Else
jelszo = Sheets(1).Cells(sor, 2)
Workbooks.Open Filename:=utvonal & FN, Password:=jelszo
'*******************************************************
'másolás
'*******************************************************
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
FN = Dir()
Loop
End Sub -
Bobrooney
senior tag
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
NextHa 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 király vagy!

-
Bobrooney
senior tag
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
NextHa 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 rálesek majd

Igen én is végül arra jutottam, hogy előtte töröljük a link-et majd újra hozzáadjuk.
-
sztanozs
veterán
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
NextHa 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.
Az a gond, hogy egy cellában egyszerre csak egy link lehet, hiába csinálsz bármit, csak egy lesz élő. Hiperlink cserénél célszerű először törölni, uátna létrehozni az újat.
-
Bobrooney
senior tag
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.
Köszönöm! Ez nekem megteszi szerintem!

-
Bobrooney
senior tag
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 SubKö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).AddressKöszi a válaszokat.
-
gebic
csendes tag
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)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
-
Zoleeh
csendes tag
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 SubNyilvá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.
Köszi!
Kipróbáltam, de nem működik, ahogy az én megoldásaim sem. Átállítja a formátumot, de csak F2 + Enter után veszi azt fel az adott cella.
Közben találtam egy megoldást, itt a fórumon olvasott alapján. Mivel az én esetemben az 1., 6. és 7. oszlop tartalmaz átalakítandó ("m/d/yyyy h:mm" formátumra) dátumot , de az 1. és 6. mindig ugyanaz, és a 6. és a 7. csak az időben különbözik mindig. Ezért működik ez:For n = 2 To ActiveSheet.UsedRange.Rows.Count
Cells(n, 1).FormulaR1C1 = DateValue(Cells(n, 1))
Cells(n, 6).FormulaR1C1 = TimeValue(Cells(n, 6))
Cells(n, 7).FormulaR1C1 = TimeValue(Cells(n, 7))
Next nDehogy ha mindhárom oszlop más napot és időt tartalmazna nem tudom mi lenne a megoldás.

-
Zalanius
tag
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 SubNyilvá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.
Új hozzászólás Aktív témák
-
Fórumok
LOGOUT - lépj ki, lépj be!
LOGOUT reakciók Monologoszféra FototrendGAMEPOD - játék fórumok
PC játékok Konzol játékok MobiljátékokMobilarena - mobil fórumok
Okostelefonok Mobiltelefonok Okosórák Autó+mobil Üzlet és Szolgáltatások Mobilalkalmazások Tartozékok, egyebek Mobilarena blogokPROHARDVER! - hardver fórumok
Notebookok TV & Audió Digitális fényképezés Alaplapok, chipsetek, memóriák Processzorok, tuning Hűtés, házak, tápok, modding Videokártyák Monitorok Adattárolás Multimédia, életmód, 3D nyomtatás Nyomtatók, szkennerek Tabletek, E-bookok PC, mini PC, barebone, szerver Beviteli eszközök Egyéb hardverek PROHARDVER! BlogokIT café - infotech fórumok
Infotech Hálózat, szolgáltatók OS, alkalmazások SzoftverfejlesztésFÁRADT GŐZ - közösségi tér szinte bármiről
Tudomány, oktatás Sport, életmód, utazás, egészség Kultúra, művészet, média Gazdaság, jog Technika, hobbi, otthon Társadalom, közélet Egyéb Lokál PROHARDVER! interaktív
- OLED TV topic
- Le Mans Ultimate
- Sony MILC fényképezőgépcsalád
- Képernyőmentes aktivitáskövetőt mutatott be a Google, ez a Fitbit Air
- Huawei Watch Fit 5 Pro - jó forma
- Milyen légkondit a lakásba?
- 5.1, 7.1 és gamer fejhallgatók
- Könyvajánló
- AMD Navi Radeon™ RX 9xxx sorozat
- exHWSW - Értünk mindenhez IS
- További aktív témák...
- HIGH END - 2026 MacBook Pro 16" 18C / 40C / 128 GB RAM - 4TB SSD - Magyar Billentyűzet - Space Black
- Mac Pro 6,1 2013 Late
- GAMER PC! i7-14700 / RTX 5080 / 32GB DDR5 / 1TB NVMe / 1000w Gold / BeszámítOK !
- ASUS ROG Strix SCAR 16 / Ultra 9 275HX / RTX5090 / 32GB / 2TB NVMe! BeszámítOK
- 27% - Corsair RMx Series RM1000x 1000W 80 PLUS Gold (CP-9020271-EU) Tápegység!
- Azonnali kézbesítés az év bármely pillanatában
- HIBÁTLAN iPhone 15 Plus 128GB Green -2 ÉV GARANCIA - Kártyafüggetlen, MS5204
- Xiaomi/Redmi telefontok csomag 70db
- Keresünk iPhone 13/13 Mini/13 Pro/13 Pro Max
- SZÁLCSISZOLT FÉM HATÁSÚ Dell Latitude 5420 14" Touchscreen i5-1135G7 16GB 512GB 1 év gar, LTE OPCIÓ
Állásajánlatok
Cég: aiMotive Kft.
Város: Budapest
Cég: Laptopműhely Bt.
Város: Budapest





