Új hozzászólás Aktív témák
-
#3100
Atomantiii
addikt
Atomantiii
addikt
Van még itt valaki?
Van egy programom, amiben image 1-et használok és ikonokat jelenítenék meg vele 16 x 16-os méretben.
Itt kezdődik a probléma, hogy eddig win 7-en és az alatti operációs rendszereken jó méretben jelennek meg az ikonok:
míg win 10 alatt sajnos nagyobb méretben jelennek meg az ikonok, mint ahogy kellene.
Hogyan lehetne ezt javítani, hogy win 10-en is helyes méretben jelenjenek meg a képek?
-
sztanozs
veterán
válasz
Vladek83
#3097
üzenetére
Vsz vagy nem azon a porton fut a szerver, vagy valami tűzfal-szabály nem engedélyezi a csatlkozást a te gépedről. (vagy pl ha a "távoli gép" a saját géped, akkor vagy nincs kiengedve a port vagy az xyz.hu nem a te publikus címedre mutat, vagy natolva van a kapcsolatod és a géped az indternet felől nem is címezhető).
-
Vladek83
tag
Sziasztok,
előre is sorry, ha a kérdés nem ide való..
Kérdésem a következő lenne:
Localhost-on működik / elérem az adatbázist:
Imports MySql.Data.MySqlClient
Public Class Form1
Dim connection As New MySqlConnection("datasource=127.0.0.1;port=3306;username=xyz;password=xyz")
Dim COMMAND As MySqlConnection
Dim table As New DataTableViszont, ha külső tárhelyre töltöm fel, akkor nem jó..
vagy rosszul adom meg az elérési utat..?Imports MySql.Data.MySqlClient
Public Class Form1
Dim connection As New MySqlConnection("datasource=xyz.hu;port=3306;username=xyz;password=xyz")
Dim COMMAND As MySqlConnection
Dim table As New DataTable
Valakinek lenne javaslata?
-
Kija
aktív tag
És akkor egy másik kérdés.
Egy adott email fiók emailjeiből szeretném lementeni a csatolmány fotókat az email tárgy mezőjéből származó nevű könyvtárba, de úgy hogy a csatolmánynak új nevet adok a könyvtár nevéből, a beérkezés dátumából és egy sorszámból.
Szuperül megszámolja a kód a csatolmányok számát az épp a for ciklus által kiválasztott emailnél, ám a mentés nem megy mert típus hibával megáll az alábbi sornál:Set myFolder = FSO.GetFolder(myPath)
A myPath egy sztring típusú változó és ezen sor előtt megkapja a megfelelő értéket. myFolder Folder típusú változó. FSO pedig FileSystemObject típus.
Mi lehet a gond? -
Zalanius
tag
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 -
Lokids
addikt
-
Lokids
addikt
Sziasztok!
Hogy oldanátok meg azt a problémát, hogy nekem két dátum közötti időpontba eső dolgok kellenek.
Az első a most (now), az rendben, de a másik az +2 hét péntek. Azaz ha ezt pénteken futtatom le, akkor könnyű, mert csak 2 hetet kellene hozzáadni, de ha hétfőn, akkor majdnem 3 hetet (az a hét + 2 hét péntekig).
Ezt a második dátumot hogy lehet letárolni egy változóba? -
-
-
-
Zalanius
tag
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
-
Lokids
addikt
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 -
Zalanius
tag
válasz
Rellind
#3073
üzenetére
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.
-
mdk01
addikt
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. -
Delila_1
veterán
válasz
Zalanius
#3067
üzenetére
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 -
SGeri-vb
újonc
Sziasztok!
Szükségem lenne kis segítségre.
Szóval, adott a feladat:
1. indításkor elindul egy videó,
2. majd ha annak vége, el kell induljon egy másik.Tehát a 2. lépéssel van a probléma, mert nem pontosan tudom, hogy mit kéne változtatni a kódon:
Private Sub AxWindowsMediaPlayer1_PlayStateChange1(ByVal sender As Object, ByVal e As AxWMPLib._WMPOCXEvents_PlayStateChangeEvent) Handles AxWindowsMediaPlayer1.PlayStateChange
If scene = 1 Then
If AxWindowsMediaPlayer1.playState = WMPLib.WMPPlayState.wmppsStopped Then
AxWindowsMediaPlayer1.URL = gamedir + "\1.2.mp4"
AxWindowsMediaPlayer1.Ctlcontrols.play()
End If
End If
End Sub
Illetve van egy scene nevű if, de az máshoz kell, az nem okozhatja a problémát...
Nem látszik a kódon, de az elején indul egy videó(1.1.mp4), majd a PlayStateChange sub-bal
kéne indulnia az 1.2.mp4-nek, miután vége lett az 1.1.mp4-nek.
Akkor indul csak az 1.2, ha a stop gombot(
) nyomom meg.
Tehát amelyik pillanatban vége 1.1-nek, el kell indulnia az 1.2-nek.Mi a probléma?
Üdv,
Gergő -
Zalanius
tag
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.
-
Vertus
újonc
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
-
e-newsee
addikt
Sziasztok, tudna nekem valaki segíteni?
Adott egy excel macro, ami annyit tud, hogy megadod neki egy tetszőleges windows ablak nevét, amibe az excelből adatokat fog bemásolgatni.
Teszi ezt úgy, hogy meg kell adni egy táblázatban magát az adatot, és hogy mit csináljon ezután a windows.Pl.: beírja az adatot, majd vár egy kicsit, majd nyom 3 tabot, beír egy másik adatot, majd nyom egy entert, aztán vár egy kicsit, majd kezdi elölről a következő excel sor alapján.
Ez nagyjából így nézne ki, ezen a táblázaton lépked végig, és beszínezi, ahol épp tart, hogy lássam:
A gondom az, hogy ha a forrás táblázat kilóg a képből, akkor nem tudom, hol tart, és mennyi van még vissza.
Olyan megoldás érdekelne, ami mondjuk a B oszlopban megnézi az utolsó színezett cella sorszámát, és folyamatosan frissíti azt a B2 cellában. Így mindig tudnám, hogy hol jár épp a macró, és mikor ér a végére.
Próbáltam összerakni internetről, de annyira láma vagyok ehhez, hogy nem sikerült.Köszi előre is!
-
Olwynn
újonc
Hello. Sziasztok
Nem tudom olvassátok-e még ezt a fórumot, de nagyon remélem. Nemrég kezdtem el VB 2017 programot használni, programozni. Régen a Delphi-t toltam.Gondjaim akadtak.
Szeretnék egy működő Json fáj olvasót készíteni a form1 -re
és egy INI fájl olvasót is.. (bár ha a json menne, akkor az INI nem is lenne fontos).A lényeg az lenne, hogy a program a json állományból kiolvasná az adatokat és egy label1.text vagy textbox1 -re írná ki. Ezt hogy?
Tudnátok ebben nekem segíteni?
Köszönöm -
Postas99
senior tag
Sziasztok!
Lenne egy érdekes problémám:
Using rdr As New System.IO.StreamReader(openFileDialog1.FileName.ToString())
Do While rdr.Peek() >= 0
InputLine = rdr.ReadLine
InputLine = InputLine.Replace("',", Chr(9))
InputLine = InputLine.Replace("'", "")
InputLine = InputLine.Replace(";", Chr(9))
oRow = oRow + 1
szazalek = oRow
System.Windows.Forms.Clipboard.SetDataObject(InputLine, True)
Try
oBook.Worksheets(1).Range("A" + oRow.ToString).Select()
Catch ex As Exception
End Try
Try
oBook.Worksheets(1).Paste()
Catch ex As Exception
End Try
ProgressBar1.Value = szazalek
Loop
rdr.Close()
End UsingAmi semmi mást nem csinálna ha nem hibázna, hogy beolvas .CSV fájlokat.
Ez idáig tiszta, de a fájlok más más felépítésűek ezért egy kódban kellene megoldanom a feldolgozást..1, CSV
'Label S.r.l.',
'Via Don Mazzucotelli, 6/A',
'24020 Gorle (BG) Italia',
'Tel. +39-035-302.812 Fax +39-035-302.815',
'',
'Dátum: ','06/08/2018 08:24','FOGYASZTÁS RECEPTENKÉNT','Oldal: ','1 - 5',
'',
'Dátum: ','2018.08.01. - 2018.08.01.','Recept:',' - ',
'Kifejezés értékben: ','Nem','Azonosító:',' - ',
'Tűrés: ','Letiltva','Eszköz:',' - ',
'',
'Recept: ','FOGAD4','Leírás: ','',
'',2, CSV
'Label S.r.l.';
'Via Don Mazzucotelli, 6/A';
'24020 Gorle (BG) Italy';
'Phone +39-035-302.812 Fax +39-035-302.815';
'';
'Date: ';'02/08/2018 12:40';'USAGES by RECIPE';'Page: ';'1 - 6';
'';
'Date: ';'01/08/18 - 01/08/18';'Scale:';' - ';
'Valuation: ';'No';'Operator:';' - ';
'Tolerance: ';'No';'Customer:';' - ';
'Recipe:';' - ';
'';A kód kiszedi soroknént és értékenként az aposztróf ' jeleket ha vessző követi ','
SCV2 esetében viszont a ';' értéket kell feldolgozni.
Az értékek a sztringbe visszairódnak, majd ezek excel meghívásával cellánként bemásolásra kerülnek a csv fájl teljes feldolgozásáig.A HIBA
hogy excelbe való másoláskor, néha téveszt és RANDOM üres sorokat is berak. Oszlopokat nem téveszt.
Ezt szeretném kiküszöbölni.
Elakadtam, hogy hol rontottam el a feldolgozást.Esetleg valaki tudna segítséget adni?
Köszönöm
-
Petya25
őstag
-
martonzso
újonc
Sziasztok, remélem jó helyre írok...
Adatbázis kezelő rendszer fejlesztésére keresek programozót. A feladat a következő lenne:
- hibajegykezelő rendszer megírása
- valami valahol meghibásodik, kap egy kódot a hiba, max 15 mező infóval, amit esetleg másik adatbázisból szed (cím, berendezések típusa stb.)
- egy mezőben nyomonkövetni a javítás státuszát
- pár egyszerűbb lekérdezés
- a program és az adatbázis elhelyezése a céges szerveren
- az adatbázis bárhonnan elérhető legyen
- napi 4-5 hibajegy keletkezik, folyamatban max 20-30Nos, a fenti pár mondat nem a legkomolyabb specifikáció, csak a feladat nagyjábóli leírása, ezért csak egy nagyságrendi árat szeretnék kérdezni, ha ez meghatározható a fentiekből.
előre is köszi!
-
Zalanius
tag
válasz
Bobrooney
#3050
üzenetére
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.
-
Bobrooney
senior tag
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!
-
#3049
Bobrooney
senior tag
csaszizoltan
#3048
Bobrooney
senior tag
válasz
csaszizoltan
#3048
üzenetére
Igen jól gondolod
-
Zalanius
tag
válasz
Bobrooney
#3045
üzenetére
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.
-
Bobrooney
senior tag
válasz
Zalanius
#3044
üzenetére
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).AddressKöszi a válaszokat.
-
Zalanius
tag
válasz
Bobrooney
#3042
üzenetére
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 -
#3043
csaszizoltan
csendes tag
Bobrooney
#3042
csaszizoltan
csendes tag
válasz
Bobrooney
#3042
üzenetére
Szia!
Gondolom az egyes celláinak elérése nem gyors vagy minden X találat után indítasz egy új átfésülést, ami fölösleges ezért
Rakd tömbbe a gyümölcsneveket (ha sokféle van, kb 100-nál több akkor bináris fába, ahol a fa egyes mutatói még két tömbben helyezkednek el tömbindexként) és másik két ugyanakkora tömbbe, hogy van X benne és van nem X benne. Ez az algoritmus egyszer fog végigfutni a munkalapon.
Érdekelne majd a "gyümölcsökre" megvalósított algoritmus, hogy beleszólhassak a gyorsabb futás érdekében.
Üdv -
Bobrooney
senior tag
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!
-
Zalanius
tag
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.
-
gebic
csendes tag
válasz
Zalanius
#3039
üzenetére
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
-
Zalanius
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) -
gebic
csendes tag
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 -
Delila_1
veterán
Az R kiinduló cellához képest a sor eltolását mutatja, a C pedig az oszlopét. Az eltolás mértéke a szögletes zárójelek közé írt érték. Ha nincs az R és/vagy a C után zárójeles érték, akkor a kiinduló cellával azonos sorról/oszlopról van szó. Ha zárójelek nélkül szerepel egy szám az R, ill. C mögött, az fix hivatkozást jelent.
R[-3]C[5] az aktív (vagy hivatkozott) cella fölötti 3. sor, és a tőle jobbra lévő 5. oszlop celláját jelöli.
RC[2] aktív cella sorában, tőle 2 oszloppal jobbra lévő cella.
A
Range("G" & sor) = "=sum(RC1:RC5)"összegzi a sor A:F celláinak az értékét. -
Lokids
addikt
válasz
sztanozs
#3033
üzenetére
Azt tudja valaki, hogy lehet makrózni azt, hogy adja össze az összes Sum-ot?
A táblázat összegeket számol, sorokban projektenként van egy összegzés.
De kellene raknom a végére egy végösszeget, ami összeadja az összes sum-ot.
Ha z excelben rákattintok a sum-ra, akkor ő okosan kijelöli nekem a már Sum-ot tartalmazó cellákat. De a képletbe valami Formula R1C1 cucc van, amit nem értek. -
Lokids
addikt
Sziasztok!
Mi a hiba itt? Nem tudok rájönni.
Workbooks(Output_F_Name).Worksheets(s_wsName).Range("F" & s_OutRow).Formula = "=Sum(F" & RowStart & ":F " & Rowend & ")"Első körben az F2
8-at kellene összeadnia. Ha nem változót írok bele, akkor meg is csinálja.
A változók megfelelő értéket kapnak. -
Zoleeh
csendes tag
válasz
Zalanius
#3027
üzenetére
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.
-
Zoleeh
csendes tag
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".
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 Sub2. 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 Sub3. 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 SubTudjátok mi lehet a megoldás? Vagy írjak egy makrót a For Sendkeys F2 Enter Next parancsok felhasználásával?
Köszi
-
Delila_1
veterán
Magyar függvények angol megfelelőjét így tudhatod meg:
Beírod a lapra a függvényt – persze úgy, hogy működjön is, helyes hivatkozásokkal.
Lapfülön jobb klikk, Beszúrás, Nemzetközi makrólap. Az új lapra átmásolod az előbbi függvényt, a hivatkozott cellákkal együtt. Megkapod az angol elnevezést. -
Lokids
addikt
Sziasztok!
Szeretnék csinálni egy Érvényesítési beállítást egy cellába makróval:
Sub Makró2()
Range("B11:B16").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:= _
"=INDIREKT(HELYETTE(HELYETTE(C8;"","";"""");"" "";""""))"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub
ez hibára fut: 1004. Application-defined or object defined error.Azért furcsa, mert ezt a makró rögzítővel csináltam. Ha végigkattintom az érvényesítés menüt és beírom a képletet, akkor megcsinálja.
=INDIREKT(HELYETTE(HELYETTE(C8;",";"");" ";""))
-
batagy
őstag
válasz
sztanozs
#3021
üzenetére
Az az érdekes egyébként, hogy mind Win7-n, mind Win10-en is a Microsoft XML, v6.0” (C:\Windows\System32\msxml6.dll ) van behivatkozva az Excel fájlban, de csak Win7-en működik.
A két dll verzió eltér:
Win10:
-------
C:\Windows\System32\msxml3.dll
MSXML 3.0
Microsoft XML Core Services
8.110.16299.15C:\Windows\System32\msxml6.dll
MSXML 6.0
Microsoft XML Core Services
6.30.16299.98Win7:
-----C:\Windows\System32\msxml3.dll
MSXML 3.0 SP11
Microsoft(R) MSXML 3.0 SP11
8.110.7601.23648C:\Windows\System32\msxml6.dll
MSXML 6.0 SP3
Microsoft(R) MSXML 6.0 SP3
6.30.7601.24000Tehát, a msxml6.dll újabb verziójában már módosulhattak az interface-ek. Ez lehetséges?
Az csak egy workaround, hogy msxml3.dll-lel működik Win10-en.
Kösz
-
batagy
őstag
válasz
sztanozs
#3019
üzenetére
Szia!
Köszönet! Tényleg, igazad volt!
A tipped alapján csekkoltam az XML-t a VBA Referenciákban.Ez látható alapból:
Ha az XML 6.0-ás verzióvól kiveszem a pipát, és berakom a 3.0-ás XML-t, akkor már működik, nincs hibaüzenet.
Neten keresve ezt és ezt találtam, ami ide vonatkozik.
"On the other hand Microsoft XML, v3.0 exposes DomDocument, DomDocument26 and DomDocument30; version is 6.30.8250.0
With other versions of Windows, like 7 and XP, both msxml3.dll and msxml6.dll expose DomDocument, DomDocument30 and DomDocument60, among others."
Ha jól értem, kétféle megoldás lehet?
1) A referenciát átírni XML 3.0-ra minden ilyen Excel fájlban? De ez hosszú távon, lehet hogy nem célravezető.
2) A DomDocument interface-t átírni olyanra hogy msxml6.dll-tal is kompatiblis legyen?Olyanra kellene megírni, hogy Win7 gépeken is fusson és kvázi (a userek számára) visszafelé is kompatibilis legyen.
Köszönet!
2)
-
batagy
őstag
Sziasztok!
Tudnátok légyszi segíteni?
Excelt speciális Visual Basic kóddal használjuk. Windows 7 és Office 2016 kombinációval jól működik.
Windows 10-en azonban hibát kapunk.A Macro engedélyezve van, és nem jogosultsági problémára gyanakszok.
Ezt a hibát kapom az Excel megnyitásakor:
Microsoft Visual Basic for Applications
Compile error:
User-defined type not definedA VBA editor erre a kódrészletre ugrik:
Option Explicit
Private myDOMDocument As New DOMDocument
Private myRoot As IXMLDOMElement
Private myValidation As IValidation
Private myIsError As BooleanÉn nem tudok Visual basicban programozni. De ezt találtam. Próbálnék egy Set-et beállítani, de akkor meg "Invalid Outside procedure" hibát kapok. Viszont nem tudom, hogyan illesszem eljárásba.
Tudnátok-e segíteni az eredeti hibánál?
Köszönet!
-
sztanozs
veterán
Ha 5 nap alatt át tudod fordítani VBA-ból VB.NET-be (és XLL-be befordítod), akkor nagyjából effektíven meg tudod védeni a belenyúlás és a forráskód megszerzése ellen. Más ésszerű lehetőséged nem nagyon van.
mod: ezt találtam még neked: [link]
Másrészről egyáltalán nem etikus, amit szeretnél. Bár éveket dolgoztál rajta, de ezt a cég érdekében (vsz a munkavégzés automatizálásából) tetted. Bár lehet, hogy rossz érzés magad mögött hagyni, mégis csak legalább annyira (igazából sokkal inkább) a cégé a kód, mint a tiéd. Alapesetben igazából magaddal sem viheted, hacsak a cégtől erre vonatkozóan nem kapsz egyértelmű felhatalmazást.
-
vilag
tag
Azt esetleg tudja valaki, hogy ha kilépek a munkafüzetből mentés nélkül, akkor miért dobja fel ezt az ablakot, amit 10 alkalommal kell "mégsézni"?
Annyi az érdekesség, hogy ha csak megnyitom a munkafüzetet és bezárom mentés nélkül akkor nem dobja fel, ha viszont már használom valamelyik gombot (amihez ugye kód is van), akkor már feldobja.
Még érdekesebb, hogy egyébként a Workbook Openben is van kód, ami ugye mindenképp lefut, ez mégsem idézi elő az ablak felbukkanását.Van ötlet?
Továbbra is várnék valami javaslatot a programkód védelmére!
Remélem van valakinek ötlete. Nem tudom szavakba önteni mennyire.
Ez a kód majdnem olyan mintha az egyik gyermekem lenne, nem akarom, hogy lenyúlják.
Mégis csak 8 éve javítgatom.Köszönöm!
-
vilag
tag
válasz
sztanozs
#2999
üzenetére
Van ötlet, hogy milyen módon lehetne megoldani a problémát?
Röviden annyi lenne, hogy otthagyom nekik a programokat használatra, viszont nem szeretném ha egyrészt a kódban babrálnának, másrészt azt sem akarom, hogy le tudják azt nyúlni.
Ezért gondoltam, hogy amolyan bünti lenne, hogy törli magát a kód ha hozzá akarnak nyúlni vagy le akarják nyúlni.Most is törölhetném a kódokat, de akkor azokkal a kollégákkal tolnék ki akiket szeretek.
Egyébként "mennyire könnyű" feltörni a projektet ha jelszavazom?
-
#3011
vilag
tag
Apollo17hu
#2998
vilag
tag
válasz
Apollo17hu
#2998
üzenetére
Köszönöm!
Meg fogom tenni.
-
Delila_1
veterán
válasz
smallmer
#3005
üzenetére
Vidd be az utvonal állandóba a saját útvonaladat, a *****-os sorban meg add meg a sablon fájlod-, és a benne lévő makró nevét.
Mivel sok fájlról van szó, hogy ne unatkozz közben, a státuszsorban kiírja 10 darabonként a másolások számát.Sub osszemasolo()
Dim FN As String, i As Integer
Dim FD, utvonal As String
Const utvonal = "D:\Főmappa\almappa\" 'jöhet a megnyitás, másolás"
ChDir utvonal
FN = Dir("*.xlsx")
Do While FN <> ""
i = i + 1
Workbooks.Open Filename:=FN, ReadOnly:=True
MsgBox "Itt másolgatunk", vbInformation
'A már kész makrót itt hívhatod meg: workbook("sablon_fájl.xltx").makró_neve *****
Workbooks(FN).Close False
FN = Dir()
If i Mod 10 = 0 Then Application.StatusBar = "Másolva: " & i & "db fájl!"
Loop
Application.StatusBar = False
MsgBox "Befejeződött az összemásolás", vbInformation, "Fájlok összemásolása"
ActiveWorkbook.Save
' ActiveWorkbook.Close
End Sub -
smallmer
őstag
válasz
sztanozs
#3003
üzenetére
Amit linkeltél két stack leírást felhasználtam.
myPath = " ide megadtam a fájlok elérési útját "
viszont ha futtatom akkor ugye kéri a macro-t amelyiket használja a megnyitás után. azt megadom neki és egyből jön egy hibaüzenet, hogy
compile error:
invalid outside proceduremit ronthattam el?
köszönöm -
sztanozs
veterán
válasz
smallmer
#3002
üzenetére
Ok, akkor ez nem annyira járható út. De simán tudsz csinálni egy másik excelt, ami először betölti a sablon-t és utána a többi excelt.
Amennyiben a sablon fájlban publikus-ként van definiálva a funkció/szubrutin, amit el akarsz érni, akkor azt probléma nélkül meg tudod tenni másik fájlból is (csak fel kell venned a sablon fájlt referenciaként). -
sztanozs
veterán
válasz
smallmer
#3000
üzenetére
A legegyszerűbb lenne, ha a sablon makrója nyitná meg a 200 excel fájlt (darabra, vagy egyszerűen csak az adott helyen levő és szabálynak megfelelő nevű fájlokat), szépen megnyitná a munkalapokat, megnézné az adatokat és vagy copy/paste vagy adatmásolással átrakná a sablon fájlba (és az elmentené más néven).
Igazából szerintem ehhez mindent megtalálsz stackoverflow-n:
Open
Copy/Paste szűrve
Furcsa.
) nyomom meg.
Új hozzászólás Aktív témák
Hirdetés
- Noblechairs HERO Fekete/Platinafehér Gamer Szék
- AKCIÓ! MSI Z690 i7 12700K 32GB DDR4 1TB SSD RX 6800 16GB Phanteks P600S Cooler Master 750W
- 4 év gari - magyar bill. - Lenovo ThinkPad Z13 G1 - AMD Ryzen R7 Pro 6850U, 13.3" 2.8K OGS érintő
- Huawei P20 Lite 64GB, Kártyafüggetlen, 1 Év Garanciával
- ÁRGARANCIA!Épített KomPhone Ryzen 9 5900X 16/32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: CAMERA-PRO Hungary Kft
Város: Budapest