- Bemutatkozott a Poco X7 és X7 Pro
- Google Pixel 9a - a lapos munka
- Magisk
- Egyszerre legnagyobb és legkisebb is a Garmin Venu X1
- Szerkesztett és makrofotók mobillal
- Megjelent a Poco F7, eurós ára is van már
- Garmin Forerunner 970 - fogd a pénzt, és fuss!
- Okosóra és okoskiegészítő topik
- Apple Watch Ultra - első nekifutás
- Amazfit Active 2 NFC - jó kör
-
Mobilarena
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
#53461
eszgé100
őstag
Fire/SOUL/CD
#53460
eszgé100
őstag
válasz
Fire/SOUL/CD
#53460
üzenetére
Az elkepzelese jo volt, csak a valosaggal nem szamolt
Story annyi volt, hogy be akarta mutatni, hogy a kulonbozo kaizenek bevezetese utan mennyivel csokkent egy-egy tipus ciklusideje visszamenoleg a kezdetektol. Hat semennyivel, mert ugyanugy 2-3 darabot epit meg a kollega, mint elotte, csak mostmar k.rva raerosen, anelkul, hogy megszakadna. Ertelmezheto adatok akkor lesznek lathaoak, ha nagyobb darabszamra lesz az igeny, lesz rajta valamennyi nyomas, es nem szakitjak felbe non-standard activitykkel.
Megmondom oszinten majdnem sirva fakadtam, mikor a kapott eredmenyt kinyomtam egy bar chartra es ugy nezett ki mint egy hullamvasut a szepen csokkeno tendencia helyett
-
eszgé100
őstag
Koszonom, idokozben irrelevanssa valt a kerdesem. Nem volt tul sok sor (<100), szoval kivalogattam a dolgokat kezzel. Ez eleg infot szolgaltatott, hogy lassuk, hogy nem azt mutatjak az adatok, amit fonok prezentalni szeretett volna, igy vegul az egesz muveletet kukaztuk.
-
eszgé100
őstag
Sziasztok!
Egy táblázatban szeretném megtalálni adott Serial number alapján adott program első és utolsó lépés timestamp-jét:
=MINIFS(AllResults[dateTime],AllResults[SerialNumber],[@[Serialnumber]],AllResults[boltID],"*PROGRAMNAME*")=MAXIFS(AllResults[dateTime],AllResults[SerialNumber],[@[Serialnumber]],AllResults[boltID],"*PROGRAMNAME*")A fenti formulákkal sikerül, de szeretném tovább bontani napokra, mert a legtöbb esetben a egy-egy programot nem fejezünk be egy (vagy rosszabb esetben több) munkanap alatt sem.
van ötletetek, hogy mivel kellene kiegészítenem a keresést?
-
eszgé100
őstag
Sajnos minden alkalommal 0-rol kezdtem, de a vege ez lett tegnap este:
forras:
let
Source = Excel.Workbook(File.Contents("C:\Users\xxxxx\OneDrive - xxxxxxxxx\Desktop\source (1).xlsx"), null, true),
Sheet1_Sheet = Source{[Item="Sheet1",Kind="Sheet"]}[Data],
#"Promoted Headers" = Table.PromoteHeaders(Sheet1_Sheet, [PromoteAllScalars=true]),
#"Changed Type" = Table.TransformColumnTypes(#"Promoted Headers",{{"ID", Int64.Type}, {"Name", type text}, {"Date", type date}, {"Qty", Int64.Type}}),
#"Removed Columns" = Table.RemoveColumns(#"Changed Type",{"Date"}),
#"Sorted Rows" = Table.Sort(#"Removed Columns",{{"ID", Order.Ascending}}),
#"Merged Queries" = Table.NestedJoin(#"Sorted Rows", {"ID"}, #"self-refer", {"ID"}, "self-refer", JoinKind.LeftOuter),
#"Expanded self-refer" = Table.ExpandTableColumn(#"Merged Queries", "self-refer", {"Comments"}, {"Comments"})
in
#"Expanded self-refer"
Merged query:
Tegnap delutan meg az eredeti adatokkal probaltam es teszteleskor miutan az forrasban a sorrendet megforditottam vagy mas oszlop alapjan rendeztem a refresh utan osszevissza toltodtek be a sorok. Ekkor meg azt gondoltam, hogy megduplazodtak, es mar csak otthon lattam, mikor a fenti peldaval probaltam, hogy a sorok szama azonos, viszont a sorrend teljesen random az elso nehany refresht kovetoen, ezert hozzaadtam egy rendezest meg a merge elott. Igy barmelyik oszlopot is atrendezve mindig ugyanezt az eredmenyt latom es a forrast is lehet boviteni illetve roviditeni.
Ma kiprobalom elesben, es irok, hogy minden ok volt-e?
Koszonom az extra tippet
-
eszgé100
őstag
Sziasztok!
Sales forecastbol szeretnek adatokat kinzerni Power Queryvel.
A forras fajlban viszonylag rendezve vannak az adatok, Power Query editorban szepen ki tudom szurni ami kell nekem.Problemam ott kezdodik, hogy a kinyert adatok tablazatahoz szeretnek manualisan hozzaadni meg ket oszlopot, amibe aztan manualisan szeretnek bevinni adatokat, jo lenne, ha frissites utan is elerhetoek lennenek.
A fenti videok alapjan probaltam beallitani self-refering tablazatokat, de egyiket kovetve sem jartam sikerrel. Van valakinek bevalt modszere, hogy hogyan kellene az ilyet csinalni?
Elore is koszonom.
-
eszgé100
őstag
Sziasztok!
Több száz munkalapról szeretnék átmásolni képeket, gyakorlatilag a landscape-ről konvertálnék portrait módba.
Az forrás lapokról csak az A1 : K32 range-ben található min. 1 max. 6 képet szeretném másolni, lehetőleg balról-jobbra fentről-lefele, majd ezeket beilleszteni fentről-lefele balról-jobbra.
Forrás: Cél:
A1-B1-C1 A1-A2
A2-B2-C2 B1-B2
C1-C2Az egyszerűség kedvéért egyesével, nem szerezném, ha groupként lennének beillesztve. Nem kell forgatni vagy újraméretezni, az igazítást is meg tudom oldani.
Szerintem egy olyan kódrészletre lenne szükségem, ami A1-től megjelöli az első képet és eltárolja, mondjuk pic1 nevű változóként, és ugyanezt megcsinálni B1-pic2, C1-pic3 stb is.
A cellák neve ne tévesszen meg senkit, azt csak példaként írtam, sajnos a vaóságban nem minden kép van rendesen beillesztve egy adott cellába.A szöveges részeket már megoldottam, a loop kész van, ami az összes lapon végigmegy, csak a képek másolását kellene valahogy belefoglalni még.
Örömmel olvasnék néhány tanácsot, hogyan keydjek neki
Előre is köszönöm
-
eszgé100
őstag
válasz
Fferi50
#52680
üzenetére
Koszonom szepen
Ezen kívül a táblázatra hivatkozás sem megfelelő.
Táblázatnév [@mezőnév] a helyes, továbbá szóköz nem lehet benne
Azt modjuk en is neztem, de amikor az IF kepletet csinaltam, hiaba javitottam at @ es a [ ]-et, hogy a megfelelo helyen legyenek, azok automatikusan visszakerultek.
Probaltam szokoz helyett "_"-al is, ezesetben is megjelentek az extra szogletes zarojelek.
Vegso megoldas, hogy egyszavasra csereltem az oszlop nevet. -
eszgé100
őstag
Sziasztok!
Meg tudnatok mondani, hogy az utolso sor miert okoz runtime error 1004-et?
1004:Application-defined or object-defined error.Az osszes keplet mukodik a tablazatban, onnan bemasolva VBA-ba viszont az utolsot nem tudom beiratni az R oszlopba.
mrs.Activate
Set tbl2 = mrs.ListObjects("Table2")
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
tbl2.Resize mrs.Range("A2:V" & lastrow + 1)
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
mrs.Range("A" & lastrow) = modnum
mrs.Range("B" & lastrow) = modtype
mrs.Range("F" & lastrow).Formula2 = "=INDEX(Lists!$M$4:$M$33,MATCH(1,([@Customer]=Lists!$K$4:$K$33)*([@Commodity]=Lists!$L$4:$L$33),0))"
mrs.Range("G" & lastrow).Formula2 = "=INDEX(Lists!$N$4:$N$33,MATCH(1,([@Customer]=Lists!$K$4:$K$33)*([@Commodity]=Lists!$L$4:$L$33),0))"
mrs.Range("J" & lastrow).Formula2 = "=INDEX(Lists!$O$4:$O$33,MATCH(1,([@Customer]=Lists!$K$4:$K$33)*([@Commodity]=Lists!$L$4:$L$33),0))"
On Error Resume Next
mrs.Range("R" & lastrow).Formula2 = "=IF([@[Planned Production Date]]<>0,[@[Planned Production Date]]+87,"")"
If Err.Number > 0 Then
Debug.Print Err.Number & ":" & Err.Description
End If -
eszgé100
őstag
Sziasztok!
Par hete osszehoztam egy Power Query lekerdezest, ami kb 30 kulonbozo Sharepoint mappabol osszefuzi nekem a benne talalhato .xls fajlokat, amik a raw data-t tartalmazzak. Meretebol adodoan a query frissitese eltart vagy 20 percig. Ezt szeretnem orvosolni valahogy.
Power BI-ban erre letezik az ugynevezett incremental refresh, ami csak hozzafuzi az uj adatokat a regihez, de eddig nem talaltam hasznalhato megoldast, ami Excelben is mukodne.
Letezik erre valamilyen alternativ megoldas?Elore is koszonom
-
eszgé100
őstag
válasz
eszgé100
#52580
üzenetére
Option Compare TextFunction PartName(s As String) As StringSelect Case TrueCase s Like "20502#[A-Z]##[A-Z]###"PartName = "Part1"Case s Like "###A-Z]######"PartName = "Part2"Case s Like "8212-9a-zA-Z]##########"PartName = "Part3"Case s Like "822846######"PartName = "Part4"'etc...End SelectEnd Functionez lett a vege
-
eszgé100
őstag
Van egyébként egy újabb kérdésem.
VBA Editorban írtam néhány funkciót, amik a vonalkód beolvasás alapján el tudják dönteni, hogy a vonalkód tartalma a megadott formátumú-e?
Így néznek ki:
Function BARCODE1(s As String) As Boolean
BARCODE1 = s Like "225211660502#[A-Z]##[A-Z]###"
End Function
Function BARCODE1_2(s As String) As Boolean
BARCODE1_2 = s Like "####[A-Z]###[A-Z]######"
End Function
Function BARCODE2(s As String) As Boolean
BARCODE2 = s Like "821216602#[!*][!*][0-9a-zA-Z]##########"
End Function
Function BARCODE3(s As String) As Boolean
BARCODE3 = s Like "822846602#[!*][!*][0-9a-zA-Z]##########"
End Function
Function BARCODE4(s As String) As Boolean
BARCODE4 = s Like "2202####[0-9a-zA-Z]######"
End Function
Function BARCODE5(s As String) As Boolean
BARCODE5 = s Like "002######1#####IN"
End FunctionRemekül működnek, ha csak egy-egy beolvasást kell összehasonlitani a formátummal.
Probléma ott van, hogy most vonalkódok tartalmából kellene az alkatrész nevét kellene kikövetkeztetni és van 30 különböző alkatrész egy majd 14000 soros táblában.Ötletem az volt, hogy beágyazom a funkciókat "HA" függvényeket egymásba ágyazom, de hamar megbántam, akkora lassulást okozott.
Másodszorra egy segédtáblára és egy xlookup-ra gondoltam wildcard karakterekkel, ahol az xlookup-ban szereplő 2252116605021a12b123-at hasonlítom össze egy wildcard karaktereket tartalmazó cella értékével, ami ezesetben 225211660502#[A-Z]##[A-Z]###-hez lenne hasonló.
Megoldható szerintetek?
-
-
eszgé100
őstag
válasz
Fferi50
#52569
üzenetére
Koszonom, holnap kiprobalom a javaslatokat es visszajelzek.
Kb 800 fajlbol kellene osszefesulnom egybe az adatokat, szoval nem szeretnek Szovegbol oszlopok-kal szorakozni egyesevel.
Egy sample fajlom volt, ami alapjan megcsinaltam a szureseket es rendezeseket, mivel az csak UK datumokkal volt tele, igy ay editor egybol datumkent kezelte. A problema akkor jelentkezett, mikor kb a 300. excel fajl-t is behuzta magatol. ideiglenes megoldaskent visszaallitottam textre, mert a timestampeket egyedi azonositokent szeretnem hasznalni. Ez az egyetlen oszlop, amire raereszthetem a duplikaciok torleset, de 90%-ban biztos vagyok benne, hogy egy szep napon a fonokom kitalalja, hogy kellene chartokat is rajzolni, ahova viszont mar rendes datumok fognak kelleni.
#52570-es valaszodra:
gondoltam erre en is, de ilyenkor nem vesznek el az ora:perc:masodpercek visszaallitaskor? A fentebb emlitett duplikaciok miatt fontosak.
-
eszgé100
őstag
Sziasztok!
Egyszer már kínlódtam az alábbi a kérdéssel, de újra fel kell tennem, de most Power Queryben kellene megoldanom ugyanezt a problémát.
Nyers adatokban kétféle képpen vannak eltárolva a timestampek UK és US formátumban. Miután Get data-val behúzom az adatokat Power Query Editorba, az oszlop automatikusan Time&Date lesz, de a US formátumú adatok ignorálva lesznek.
13/12/2022 09:29:21
12/13/2022 9:30:47 AMKérdésem tudnám a US formátumú timestampeket UK DD/MM/YYYY 24 órás formátumra átkonvertálni, mielőtt ignorálva lennének?
excelben erre ezt a megoldást találtam ki anno néhány topiklakó segítségével:
H11 cella: 12/13/2022 9:30:47 AM
J11 cella: =OR(ISNUMBER(SEARCH("am",H11)),ISNUMBER(SEARCH("pm",H11)))uk formátum:
=IF(J11=FALSE,H11,DATE(RIGHT(LEFT(H11,FIND(" ",H11)-1),4),LEFT(H11,FIND("/",H11)-1),MID(H11,SEARCH("/",H11)+1,SEARCH("/",H11,SEARCH("/",H11)+1)-SEARCH("/",H11)-1))+(TIME(HOUR(MID(H11,FIND(" ",H11)+1,1256)),MINUTE(MID(H11,FIND(" ",H11)+1,1256)),SECOND(MID(H11,FIND(" ",H11)+1,1256)))))
Gyakorlatilag felszeletelni a stringet, majd összerakni a helyes sorrendben.
Hasonló logika alapján meg lehet oldani ezt Power Query-ben is?
Előre is köszönöm
-
eszgé100
őstag
Sziasztok!
Azt szeretnem kerdezni, hogy meg tudom-e keresni a negativ szamokat az alabbi kepen lathato sorrendben?
A1 cellaba szeretnek egy kepletet, ami megadja az elso negativ szam oszlopat.Feladat, hogy a megtalalom eloszor -522-t, A1 cella erteke "B", majd miutan elvegeztem bizonyos feladatokat es az a szam pozitvva valik, akkor talalja meg a -254-et , A1 cella erteke meg mindig "B", majd -16, ahol A1 cella mar "C", majd -417.6, ahol A1 erteke "G" es igy tovabb.
Elore is koszonom
-
eszgé100
őstag
"return eredmenyt" hasznaltam, mert kellenek a hibas beolvasasok is, sot igazabol az a lenyeg, hogyha hibas akkor ki legyen emelve.
fenti peldadbol kiindulva, ha 20 kulonbozo formatumu beolvasast akarok ellenorizni, akkor letre kell hoznom mindegyiknek egy-egy segedoszlopot, ahova a fenti keplet modositott verziojat beirom vagy van valamilyen kifinomultabb lehetoseg, pl nested if keplet, amit hasznalhatnek?
-
eszgé100
őstag
Sziasztok!
Van egy meglévő Excel táblám, aminek 2 munkalapjára bemásolom egy-egy munkaállomás eredményeit, majd ezek alapján a Report munkalapon, ami tele van formulákkal, automatikusan kapok egy riportot.
A héten önszorgalomból elkezdtem Power BI-t is tanulni, hogy egy helyre be tudjam csatornázni az összes valaha elkészült és jövőben elkészülő eredményeket. Beállítottam, hogy melyik mappákat figyelje a SharePoint-ról, egyelőre még manuálisan kell frissiteni, de ha új eredmények kerülnek a mappába felismeri őket és működik. Ezzel máris kipipáltam az ide-oda másolgatást.
Első feladatnak azt tűztem ki, hogy az Excel munkafüzetem, ami a riportokat készíti ki megpróbálom átkonvertálni Power BI-ba, és ahelyett, hogy külön riportokat és fájlokat generálnék minden elkészült termékhez, szépen csak szériaszám alapján kiíratom, amelyikre éppen kíváncsi vagyok (plusz még egyéb dolgokra is rá tudok szűrni)
Ezzel kapcsolatban az első kérdésem az, hogy pl az alábbi funkció generál nekem egy TRUE/FALSE értéket, ami az alapja a feltételes formázásnak
Function Is_XYZ_Scan_Accurate(s As String) As Boolean
Is_XYZ_Scan_Accurate= s Like "###[A-Z]########[0-9a-zA-z]#######"
End Functionhogyan tudnám Power BI-ban is megoldani?
Előre is köszönöm
-
eszgé100
őstag
válasz
Delila_1
#50616
üzenetére
Köszönöm neked is és lappynak is, de nem erre gondoltam, kicsit talán félreérthető volt a screenshotom.
Amit az első képen láttok az 1 db cella tartalma, ami egy vba által készített több soros (vbnewline) string.
lappy által is linkelt kód volt az kiinduló pont, magát a színezést meg tudtam oldani én is, kérdésem az volt, hogy amikor belekattintok a vba által kitöltött és kiszínezett cellába, hogy további kommenteket írjak, akkor az egész színezés eltolodik, az eredmény a második képen található, ezt szeretném kiküszöbölni -
eszgé100
őstag
Sziasztok!
az alabbi koddal szinezem ki a TRUE es FALSE szavakatFor i = 1 To Len(summary.Range("E25"))
If LCase(Mid(summary.Range("E25"), i, Len("False"))) = LCase("False") Then
summary.Range("E25").Characters(i, Len("False")).Font.ColorIndex = 3
End If
Next i
For i = 1 To Len(summary.Range("E25"))
If LCase(Mid(summary.Range("E25"), i, Len("True"))) = LCase("True") Then
summary.Range("E25").Characters(i, Len("True")).Font.ColorIndex = 4
End If
Next iMukodik is szepen, egeszen addig mig meg nem probalok valami mast is beleirni a cellaba, ugyanis ekkor a szinezett betuk "eltolodnak" lasd az alabbi kepeken:
ezt hogyan tundam orvosolni?
-
eszgé100
őstag
szia, nem működött, de az egymásba ágyazott keresés adott egy ötelet.
=XLOOKUP(1,(B1:B11="TRUE")*(C1:C11=F1),D1:D11,XLOOKUP(F1,(C1:C11),D1:D11,"No Match",0,-1),0,1)
legszebb, hogy az utolsó kapcsolóval tudom állítani, hogy az előről kezdje a keresést, vagy a végéről, ha nincs találat, akkor egyszerűen csak a legutolsó "3"-t keresem meg, feltétel nélkül, ha egyáltalán nincs 3-as sem, akkor "No Match"
mindenesetre köszönöm a segítséget
-
eszgé100
őstag
Sziasztok!
Szeretném A1-be megtalálni "d"-t (D4) feltétel, hogy a C oszlop legyen 3, B oszlop pedig az első TRUE.
A fenti formulával próbálkoztam, de az duplikáció esetén figyelmen kívül hagyja, a B oszlopot és utolsó 3-ashoz tartozó betűt adja eredményként, az figyelmen kívül hagyva, hogy B oszlop TRUE vagy FALSE -
eszgé100
őstag
válasz
Fferi50
#50383
üzenetére
Szia
"Pontosan milyen feltételeknek kell megegyezniük ahhoz, hogy TRUE legyen az eredmény?"
A TRUE eredményt készen kapom, nem nekem kell meghatároznom, van egy programunk, ami rögzíti az eredményeket, és bizonyos paraméterek alapján eldönti, hogy az adott feladat megfelelően lett-e elvégezve? Ha minden paraméternek megfelelt, akkor TRUE, ha valami nem jó, akkor FALSE.
Miért van az, hogy a második képen a MODEL1SUB2_2_3 első sorában FALSE van, a második előforduláskor pedig TRUE?
Valóságban ez egy csavart jelképez, amit egy bluetooth-os nyomatékkulccsal húzunk meg. A program kiküldi a beállításokat a nyomatékkulcsra, majd a nyomatékkulcs visszaküldi a meghúzási nyomatékot, az elfordulás szögét, hányadik csavart húzta meg a programnak, és amennyiben valamelyik érték nem megfelelő, akkor a program FALSE eredményt ír be a Statushoz, majd engedélyez egy újabb próbát, ami ha sikerül, akkor TRUE lesz, 3x lehet próbálkozni, utána supervisor átveszi. FALSE eredményt kaphatunk még akkor is, ha egy lépést vissza- vagy előreugrunk, valamint, ha nem megfelelő értékeket viszünk be a value vagy text inputhoz.A második táblázat hogyan keletkezik?
A táblázat a program log file-ából van kimásolva, egyelőre kézzel, még nem foglalkoztunk automatizálással, de nem hiszem, hogy ez gondot fog okozni a későbbiekben.
Nekem személy szerint csak egy listára van szükségem a végén, hogy volt-e olyan lépés, ami kimaradt, vagy FALSE a Status, és nem lett később korrigálva, illetve, hogy egy-egy lépés volt-e duplikálva, annak ellenére, hogy már elsőre is TRUE volt stb. Ezt az egészet el tudom képzelni, akár egy külön oszlopban a steps tabon, amit aztán egyszerűen leszűrhetünk.
A programban vannak bugok, pl ha egy legördülő listából valasztjuk ki a Step Numbert, akkor arról semmilyen bejegyzés nem keletkezik, legrosszabb esetben egy-egy (vagy akár több) lépés is kimaradhat, ezért nem merjük magunkat teljesen rábízni, kézzel pedig 30-40 perc átnyálazni az eredményeket.
Jelenleg a kézzel ellenőrzött eredmények alapján készítünk egy riportot, kategóriákra bontva és számszerűsítve a dolgokat.
-
eszgé100
őstag
Sziasztok!
Van két táblázatom, ahol az eredményeket szeretném összehasonlítani.
Az első táblázat tartalmaza a lépéseket, ezeket használnám feltételként, a második az eredményeket, miszerint ha összes feltétel egyezik + a Status TRUE, akkor léphetek a következő lépésre, FALSE esetén tudni akarok róla, hogy melyikkel volt a hibalépések:
eredmények:
a második táblázatban a Bolt ID az első táblázat Program ID_Step Number-ből állítjuk elő, ha viszont a Type of Operation "fastening", akkor hozzáadódik még a Batch Size is _1 _2 _3 _4 formátumban.
Érdemes az ilyen feladatra makrót írni, vagy létezik valamilyen funkció, amivel ki tudom szűrni, a hibákat.
Lényeg annyi, hogy az összehasonlítás végén akkor leszek happy, ha minden Bolt ID Status-a TRUE, duplikáció esetén az utolsó bejegyzés TRUE , és ne maradjon ki egyik lépés sem.
-
eszgé100
őstag
köszönöm, kicsit variálni kellett
1) le kellett szeletelnem a dátumot B oszlopba =LEFT(A1,10)-el,
2) az időt C oszlopba =RIGHT(A1,LEN(A1)-11-el,
3) D oszlopba a mm/dd/yyyy > dd/mm/yyyy konvertálás =DATE(RIGHT(B1,4),LEFT(B1,2),MID(B1,4,2))
4) E oszlopba 24 órás formátumra konvertálás =TIME(HOUR(C1),MINUTE(C1),
SECOND(C1))-el
5) F oszlopban visszaegyesiteni =D1+E1
6) G1=F286-F1 cellaformázás: d "day(s)" hh:mm:ss1-től 5-ig szerinted le lehetne írni egy formulában is is?
=(DATE(RIGHT(LEFT(A286,10),4),LEFT(LEFT(A286,10),2),MID(LEFT(A286,10),4,2))+TIME(HOUR(RIGHT(A286,LEN(A286)-11)),MINUTE(RIGHT(A286,LEN(A286)-11)), SECOND(RIGHT(A286,LEN(A286)-11))))-(DATE(RIGHT(LEFT(A1,10),4),LEFT(LEFT(A1,10),2),MID(LEFT(A1,10),4,2))+TIME(HOUR(RIGHT(A1,LEN(A1)-11)),MINUTE(RIGHT(A1,LEN(A1)-11)), SECOND(RIGHT(A1,LEN(A1)-11))))
Le
-
eszgé100
őstag
válasz
eszgé100
#50198
üzenetére
Sziasztok!
Korábbi kérdésemből csak az "adott pötty fölé viszem az egeret, akkor megjelenítse a szériaszámot" maradt aktuális
Megoldható, hogy a Point "18/01/2023" helyett egy másik cella értéke legyen megjelenítve, pl C1-ben -37 van, viszont kellene a hozzá tartozó B1?
Másik újabb kérdésem a scatter plot charttal kapcsolatban, hogy meg lehet oldani, hogy a x tengely Dátum az adott tárgyhó 1-től induljon és tárgyhó végével érjen véget? Automatikusan Excel kiterjeszti a tengelyt mindkét irányba, hiába nincs semmilyen adat y-tengelyen megjelenítve. Kézzel meg tudom oldani, de ezt minden hónapban el kellene játszni, jobb lenne automatikus megoldás.
-
eszgé100
őstag
Sziasztok,
Eloszor is szeretnek Boldog Ujevet kivanni az egesz csoportnak
Valtozatossag kedveert most egy scatter plot charttal (szorasdiagram?) kinlodok.
x tengely datum, targyho 1-tol utolso napig
y tengely meresek eredmenyeegy nap tobb erteket is fel kellene vinni, es szeretnem, ha ezek szinkodolva lennenek, attol fuggoen, hogy melyik tipusu modellhez tartozik a meres. 4 kulonbozo tipus van plusz egy mesterdarab, amit mindennap ellenorzunk. Tablazatban, ahonnan az adatok jonnek Datum, Modell, Szeriaszam, Eredmeny, Min es Max tures (utobbi ketto csak a felteteles formazas miatt, de akar a diagramon is jol jonnenek, pl szaggatott vonalkent jelolve).
Kerdesem, hogy a fenti adatokbol lehetne olyan grafikont keszteni, ahol a tipusok szinkod szerint el vannak kulonitve, plusz ha az adott potty fole viszem az egeret, akkor megjelenitse a szeriaszamot es esetleg a turesek be legyenek jelolve?
Elore is koszonom
-
eszgé100
őstag
Sub saveweeklycopy()
Dim name As String
Dim sharepoint As String
Dim weekcom As Date
Dim weeknum As Integer
weekcom = Sheets("Sheet1").Range("B2")
weeknum = Sheets("Sheet1").Range("B3")
name = Format(weekcom, "YYYYMMDD") & ("_WK" & weeknum) & ".xlsm"
sharepoint = "https://companyname.sharepoint.com/sites/projectname/Shared%20Documents/ourfolders/myfolders/Trial/"
MsgBox sharepoint & name
ThisWorkbook.SaveCopyAs filename:=sharepoint & name
End SubSziasztok!
az alabbi kod remekul mukodik, ha SaveAs-t hasznalok, viszont annyi a gond vele, hogy nekem egy biztonsagi mentest kellene keszitenem az eredeti fajlon viszont szeretnek tovabb dolgozni. SaveCopyAs Runtime 1004-el elszall...
Sorry we couldn't find xy file. Is it possible it was moved, renamed or deleted?
SaveAs siman letrehozza az uj fajlt, nem ertem, hogy mi lehet a ketto kozt a kulonbseg?
Mi a pontos modja, hogy biztonsagi mentest csinaljak, majd folytathassam a munkat az eredetin? -
eszgé100
őstag
válasz
eszgé100
#50096
üzenetére
megtalaltam mi a hiba, viszont igy egy masik kerdes merult fel.
F, G, H oszlopban felteteles formazas van ervenyben, 0 eseten a betu es hatter szine feher, ami jo is addig amig a Customert es a Commodity-t ki nem valasztom egy legordulo listabol. Ekkorra az index formulak eredmenye mar nem 0, szoval a felteteles formazasnak el kellene tunnie, de a feher betuszin nem valtozik meg valamiert, tudtok erre valami magyarazatot? -
eszgé100
őstag
sziasztok,
van egy allandoan bovulu tablazatom, a lenti koddal terjesztek ki mielott adatokat viszek be.
problemam a formulakkal van, miutan a tablazat merete megvaltozott a formula nem ad eredmenyt, csak ha bezarom es ujranyitom a munkafuzetet.
Van valami otletetek, hogy mikent tundam ezt orvosolni?mrs.Activate
Set tbl2 = mrs.ListObjects("Table2")
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
tbl2.Resize mrs.Range("A2:N" & lastrow + 1)
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
mrs.Range("A" & lastrow) = modnum
mrs.Range("B" & lastrow) = modtype
mrs.Range("F" & lastrow).Formula2 = "=INDEX(Lists!$L$4:$L$33,MATCH(1,([@Customer]=Lists!$J$4:$J$33)*([@Commodity]=Lists!$K$4:$K$33),0))"
mrs.Range("G" & lastrow).Formula2 = "=INDEX(Lists!$M$4:$M$33,MATCH(1,([@Customer]=Lists!$J$4:$J$33)*([@Commodity]=Lists!$K$4:$K$33),0))"
mrs.Range("H" & lastrow).Formula2 = "=INDEX(Lists!$N$4:$N$33,MATCH(1,([@Customer]=Lists!$J$4:$J$33)*([@Commodity]=Lists!$K$4:$K$33),0))" -
eszgé100
őstag
sajnos nem egészen jó, viszont valószínű fel fogom tudni használni.
a makró működik, de csak abban az esetben, ha a cella tartalma egy 123456789012.abc formátumú szöveg, nálam pedig B2 cella:
=INDEX(Lists!$L$4:$L$33,MATCH(1,([@Customer]=Lists!$J$4:$J$33)*([@Commodity]=Lists!$K$4:$K$33),0))azt fogom csinálni, hogy mielőtt szükség lenne rá, egy másik makróval kimásolom a többi releváns adattal együtt, és Paste as Value-val beillesztem egy másik munkalapra, ahol már le tudom futtatni a fenti kódot.
köszönöm szépen
-
eszgé100
őstag
Sziasztok!
az egyik cellámban ez a formula található
=INDEX(Lists!$L$4:$L$33,MATCH(1,([@Customer]=Lists!$J$4:$J$33)*([@Commodity]=Lists!$K$4:$K$33),0))
ami ilyen formátumban ad vissza értékeket: 123456789012.abc
meg lehetne oldani, hogy a fenti példából az 5 és a 890 külön legyen formázva, teszem azt alapból 10-es normál betűméret, az 5-890 pedig 16 vastag legyen?
előre is köszönöm
-
#48487
eszgé100
őstag
Fire/SOUL/CD
#48469
eszgé100
őstag
válasz
Fire/SOUL/CD
#48469
üzenetére
Pedig valahogy kenytelen leszek elkuloniteni oket.
Ugye az egesz ciklus vegigmegy kulonbozo munkafuzeteken, es azokbol szemezgeti ki a munkalapokat. Egy-egy munkafuzetbol tobb lap is hasznalva van, de a ciklus kulonbozo reszein. Ha mindent read-onlyra allitanek, akkor azzal nagyon lelassitanam a ciklust.
Olyasmi megoldason gondolkozok, hogy amikor megvizsgalok egy fajlt es 0 a hibakod nincs megnyitva, akkor megnyitja, plusz valahova eltarolja, hogy en nyitottam meg, es legkozelebb, mikor ugyanehhez a fajlhoz erek, akkor a 70-es hibakodnal meg azt is megvizsgalom, hogy en nyitottam-e meg, ha igen, akkor nincs mit tenni, mehet tovabb, viszont amikor talalok egy olyan 70-es hibakodu fajlt, ami nincs eltarolva az altalam megnyitott munkafuzetek kozott, akkor azt read-onlykent megnyitja, majd ugy fut tovabb a ciklus -
eszgé100
őstag
Sziasztok!
Az alabbi funkcioval megvizsgalom, hogy egy adott fajl meg van-e mar nyitva a ciklus egy korabbi lepesebeol, ha nincs, akkor a kovetkezo lepes a ciklusban megnyitja a hatterben elokeszitve a kod tovabbi lepeseihez.
Remekul mukodik, de sajnos halozaton megosztottak a munkafuzetek igy elofordul, hogy mas is eppen hasznalja valamelyiket. Ebben az esetben ugyanugy 70-es hibakodot kapok, ami szerint meg van nyitva, de nem tudok innentol kulonbseget tenni, hogy az a sajat gepemen van-e megnyitva, vagy valaki masen. Olyan feltetelt szeretnek megvizsgalni, hogyha mas felhasznalonal van megnyitva, akkor nalam automatikusan nyiljon meg Read-Only modban, ugyanugy hatterben.
Function IsFileOpen(sPath As String)
Dim fileNum As Integer
Dim errNum As Integer
'Allow all errors to happen
On Error Resume Next
fileNum = FreeFile()
'Try to open and close the file for input.
'Errors mean the file is already open
Open sPath For Input Lock Read As #fileNum
Close fileNum
'Get the error number
errNum = Err
'Do not allow errors to happen
On Error GoTo 0
'Check the Error Number
Select Case errNum
'errNum = 0 means no errors, therefore file closed
Case 0
IsFileOpen = False
'errNum = 70 means the file is already open
Case 70
IsFileOpen = True
'Something else went wrong
Case Else
IsFileOpen = errNum
End Select
End FunctionA kodreszlet, ami a megnyitast vegzi:
Application.ScreenUpdating = True
ma.Visible = True
fileName = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
Application.StatusBar = "Processing File: " & fileName
Application.ScreenUpdating = False
If IsFileOpen(sPath) = False Then Workbooks.Open sPath
Windows(fileName).Visible = False -
eszgé100
őstag
Sziasztok!
Azt szeretném kérdezni, hogy tudnátok ajánlani néhány hasznos Excel tanfolyamot?
LinkedIn, Udemy, vagy akár youtube-csatornák amire érdemes feliratkozni?
VBA-t még könnyebben megértem, de jó lenne azt is nem olyan alapszinten csinálni, mint ahogy idén és hasznos lenne mélyebben elmerülni benne, valamint az általános Excel funkciókkal alaposabban megismerkedni, mert sajnos még egy sima táblázatrajzoláshoz is hülye vagyok, a képletekhez meg pláne. Minap akartam csinálni egy speadsheet-et az idei befektetéseimről, és rájöttem, hogy megint kezdhetem előről a kérdezősködést, ha normálisan akarom csinálni.Jó dolog a guglizás meg a fórumozás, de azért mégiscsak az lenne a legtutibb, ha nem csak egy-egy dologba ugranék bele randomszerűen, hanem az alapoktól építeném fel a tudásom, és így könnyebben tudnék boldogulni már rövid távon is.
Előre is köszönöm
-
-
eszgé100
őstag
válasz
Fferi50
#47925
üzenetére
A fájl szűrés nélküli állapotban nyílik meg, és a manual update értéke ''no".
Ha kézzel átállítom "yes"-re függetlenül attól, hogy szűrtem-e, akkor alábbi kóddal tudtam megoldani, de nem vagyok benne biztos, hogy jól csináltam.Set scrange = ws.UsedRange.Columns("D").SpecialCells(xlCellTypeVisible).Find(what:=sPath, after:=Range("D" & counter))
cntifres = WorksheetFunction.CountIfs(ws.Range("D2 : D" & lastrow), scrange, ws.Range("P2 : P" & lastrow), "yes")
If cntifres = 0 Then
If scrange.Row <= counter Then
Excel.Workbooks(fileName).Close SaveChanges:=True
ElseIf manualcheck = False & CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True
End If
End IfAlapból a fájlokat nem látható ablakban nyitom meg, ezért még kellett a makró végére ez is, hogy megjelenjenek:
If manualcheck = True Then
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 2
Do While counter <= lastrow
If Not ws.Range("A" & counter).EntireRow.Hidden Then
sPath = ws.Range("D" & counter)
fileName = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
manual = ws.Range("P" & counter)
If CStr(manual) = "yes" Then Windows(fileName).Visible = True
End If
counter = counter + 1
Loop
ma.Activate
Range("A1").Select
MsgBox "Update and print the sheets manually"
Else: MsgBox "Done!"
End IfRánézésre jól csináltam mindent?
-
eszgé100
őstag
válasz
Fferi50
#47916
üzenetére
1a.) megnyitott fájlok ellenőrzésének gondolata már piszkálta nekem is a fantáziám, de bevallom, lusta disznó voltam foglalkozni vele, pedig egy nem túl bonyolult IsFileOpen funkciót használva 9 másodperccel lett gyorsabb.
1b.) valószínűleg a későbbiekben sorszámozva leszek a sheetek, hogy a fizikai lokáció szerinti sorrendben legyenek kinyomtatva, így egy helyszínre csak egyszer kell ellátogatni anélkül, hogy időt pocsékolnék a papírok válogatásával, de ezt még nem találtam ki pontosan, hogy hogy legyen.
3a.) még tesztelnem és gugliznom kell, hogy tovább kommenteljem
3b.) Save & Close most ilyen lett:'time to save&close
Set scrange = ws.UsedRange.Columns("D").SpecialCells(xlCellTypeVisible).Find(what:=sPath, after:=Range("D" & counter))
If scrange.Row <= counter Then
Excel.Workbooks(fileName).Close SaveChanges:=True
ElseIf manualcheck = False & CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True
End Ifamivel annyi problémám van, hogyha így állítom be az értékeket, akkor bezáródik, hiába volt "yes" valamelyik cella a Manual Update oszlopban
ha a manualcheck-et is beteszem az első feltételbe, akkor run time error-t kapok
-
eszgé100
őstag
válasz
Fferi50
#47894
üzenetére
1.) pontosan, ott nem kell bezárni a fájlt, mert még a ciklus későbbi lépéseiben még szükség lesz rájuk, pl amikor egy workbookban van 20 worksheet, de nem egyszerre ömlesztve akarom őket kinyomtatni, mert utána akkor még kézzel is le kell válogatnom később, amit nem szeretnék. A Save&Close oszlop celláinak értéke az =IF(COUNTIF(D2:INDIRECT("D" & COUNTIF(D
,"<>")),D2)>1,"no","yes") függvénnyel van meghatározva, ami eddigi tesztjeim alapján dinamikusan változik, amikor ugyanaz az elérési útvonal kerül a Path oszlop celláiba. Amennyiben az adott elérési útvonal nem ismétlődik többet a maradék cellatartományban az érték Save&Close "yes"-re változik és a workbook ment és bezárul2a.) mi pontosan a hátránya, hogyha GoTo-val ugrálok?
2b.) Másik ezzel kapcsolatban, hogy a Mod funkció működését nem teljesen értem, legalábbis az én esetemben. Pl ha "6 monthly"-t keresem, akkor azokat a hónapokat keresem, amelyeket 6-al oszthatóak maradék 1-el? Ez január és július esetében (1/6= 0 maradék 1) és (7/6=1 maradék 1), "yearly" pedig (1/12=0 maradék 1)?
2c.) címkéket megszűntettem if - end if-eket használva3.) hibakezelés, pl valami létfontosságú cella nincs kitöltve. Szűrést pedig úgy értem, hogy kézzel leszűröm az adatokat, majd arra eresztem rá a makrót, hiba a Save&Close-nál van, mert olyankor is a maradék tartományt figyeli, mikor az egyébként a szűrés miatt nem látszik.
+ A kódhoz hozzáadtam egy response-t, ami a user arcába tolja, hogy a makró milyen nyomtatókat fog használni, mindkettőt le kell okézni, csak így kerül az ellenörző cellába, ahonnan a makró majd használja. Ha valamelyik cella üres, akkor a kód megáll, és informálja a usert. Ezen kívül még hozzáadtam egy manual update oszlopot is az adattáblán, alapból ki van kapcsolva, de ha "yes" az értéke, akkor csak megnyitja a workbookot, majd megy tovább a ciklus, valamint egy néhány sort, hogy szűrést és manual update-et alaphelyzetbe állítsa miután a fájl megnyílik.
így néznek ki:
Sub Auto_Open()
Dim start As Date
Dim weekcom As Date
Dim today As Date
Dim response As VbMsgBoxResult
Dim lo As ListObject
Dim ws As Worksheet, ma As Worksheet
Dim lastrow As Long
Set lo = Worksheets("OpenClose").ListObjects(1)
lo.AutoFilter.ShowAllData
Set ma = Workbooks("FillerPrinter.xlsm").Worksheets("MainAssembly")
'ma.Unprotect "123"
Set ws = Workbooks("FillerPrinter.xlsm").Worksheets("OpenClose")
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("P2:P" & lastrow) = "no"
Worksheets("MainAssembly").Activate
Range("A1").Select
start = Sheets("MainAssembly").Range("F3").Value
today = Sheets("MainAssembly").Range("F7").Value
weekcom = start
Do While weekcom < today
weekcom = weekcom + 28
Loop
Sheets("MainAssembly").Range("F6").Value = weekcom
Dim Printers() As String
Dim N As Long
Dim S As String
Dim col As String
Dim bw As String
Printers = GetPrinterFullNames()
Sheets("MainAssembly").Range("F8:F9").Value = ""
For N = LBound(Printers) To UBound(Printers)
S = Printers(N) 'S & Printers(N) & vbNewLine
If InStr(S, "Microsoft") <> 0 And InStr(S, "Print") <> 0 Then col = S
If InStr(S, "HP Photosmart Wireless B109n-z") <> 0 And InStr(S, "Print") = 0 Then bw = S
Next N
response = MsgBox(col, vbOKCancel, "Confirm the Colour Printer")
If response = vbOK Then
Sheets("MainAssembly").Range("F8").Value = col
Else: MsgBox "Stop-Call-Wait", vbOKOnly
Exit Sub
End If
response = MsgBox(bw, vbOKCancel, "Confirm the B&W Printer")
If response = vbOK Then
Sheets("MainAssembly").Range("F9").Value = bw
Else: MsgBox "Stop-Call-Wait", vbOKOnly
Exit Sub
End If
'ma.Protect "123"
End SubSub EOM_Main_Assy_Workbooks()
'loop:
Dim sPath As String, ssheet As String, fileName As String
Dim lastrow As Long, counter As Long
Dim ws As Worksheet, tp As Worksheet, ma As Worksheet
'print:
Dim bw As String, col As String
Dim toprint As Boolean
'from main worksheet:
Dim sDate As String
Dim sWeek As String
Dim sWkcom As String
Dim nextmonth As Date
'from Table:
Dim freq As String
Dim area As String
Dim loc As String
Dim dat As String
Dim week As String
Dim wkcom As String
Dim procloc As String
Dim procname As String
Dim machloc As String
Dim machname As String
Dim printer As String
Dim copies As Integer
Dim saveandclose As String
Dim manual As String
Dim manualcheck As Boolean
sDate = "=[FillerPrinter.xlsm]MainAssembly!$F$4"
sWeek = "=[FillerPrinter.xlsm]MainAssembly!$F$5"
sWkcom = "=[FillerPrinter.xlsm]MainAssembly!$F$6"
Set ma = Workbooks("FillerPrinter.xlsm").Worksheets("MainAssembly")
nextmonth = ma.Range("F4")
col = ma.Range("F9")
bw = ma.Range("F9")
'1st condition
If ma.Range("F8") = "" Or ma.Range("F9") = "" Then
MsgBox prompt:="One or both printers are not selected." & VBA.Constants.vbNewLine & "Please click on Update / Reset button!" & VBA.Constants.vbNewLine & "If not sure, please S-C-W!"
Exit Sub
End If
'End of 1st condition
Set ws = Workbooks("FillerPrinter.xlsm").Worksheets("OpenClose")
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 2
manualcheck = False
Do While counter <= lastrow
'2nd condition
If Not ws.Range("A" & counter).EntireRow.Hidden Then
freq = ws.Range("A" & counter)
area = ws.Range("B" & counter)
loc = ws.Range("C" & counter)
sPath = ws.Range("D" & counter)
ssheet = ws.Range("E" & counter)
dat = ws.Range("F" & counter)
week = ws.Range("G" & counter)
wkcom = ws.Range("H" & counter)
procloc = ws.Range("I" & counter)
procname = ws.Range("J" & counter)
machloc = ws.Range("K" & counter)
machname = ws.Range("L" & counter)
printer = ws.Range("M" & counter)
copies = ws.Range("N" & counter)
saveandclose = ws.Range("O" & counter)
manual = ws.Range("P" & counter)
'freq check
Select Case CStr(freq)
Case "4 weekly", "monthly"
toprint = True
Case "2 monthly"
toprint = Month(nextmonth) Mod 2 = 1
Case "3 monthly"
toprint = Month(nextmonth) Mod 3 = 1
Case "6 monthly"
toprint = Month(nextmonth) Mod 6 = 1
Case "yearly"
toprint = Month(nextmonth) Mod 12 = 1
End Select
'open sheets
'3rd condition
If toprint Then
Application.ScreenUpdating = True
ma.Visible = True
fileName = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
Application.StatusBar = "Processing File: " & fileName
Application.ScreenUpdating = False
Workbooks.Open sPath
Windows(fileName).Visible = False
'4th condition
If CStr(manual) = "no" Then
'update sheets if necessary
If CStr(dat) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(dat).Formula = sDate
If CStr(week) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(week).Formula = sWeek
If CStr(wkcom) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(wkcom).Formula = sWkcom
If CStr(procloc) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(procloc).Formula = procname
If CStr(machloc) <> "" Then Workbooks(fileName).Sheets(ssheet).Range(machloc).Formula = machname
'print sheets
Set tp = Workbooks(fileName).Worksheets(CStr(ssheet))
Select Case CStr(printer)
Case "col"
Application.ActivePrinter = col
tp.PrintOut copies:=CStr(copies)
Case "bw"
Application.ActivePrinter = bw
tp.PrintOut copies:=CStr(copies)
Case Else
MsgBox "No printer selected"
End Select
'wait here a bit
Do While ActiveWindow.View = xlPrint
Loop
'time to save&close
If CStr(saveandclose) = "yes" Then Excel.Workbooks(fileName).Close SaveChanges:=True
Else:
'Windows(fileName).Visible = True
manualcheck = True
'End of 4th condition
End If
'End of 3rd condition
End If
'End of 2nd condition
End If
counter = counter + 1
Loop
Application.StatusBar = "Done!"
Application.ScreenUpdating = True
ma.Activate
Range("A1").Select
If manualcheck = True Then
MsgBox "Update and print the sheets manually"
Else: MsgBox "Done!"
End If
End Sub -
eszgé100
őstag
válasz
Fferi50
#44543
üzenetére
"Nem tudom hány xls-ed van, de nem hiszem, hogy mindegyiket külön-külön el kellene látni ugyanazon funkciókat végző makrókkal. Én egy alap Excelt használnék, amiben a makrók benne vannak és abból intézném az összes többinek a megnyitását és kezelését. Így csak egy fájlt kell karbantartani, nem pedig x db-ot.
De lehet, hogy rosszul látom.
Üdv."Üdv Fferi50,
Nem láttad rosszul a dolgokat, jelenleg így állok a dologgal:
Ez a kód lefut megnyitáskor:
Option Explicit
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" ( _
ByVal HKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" _
Alias "RegEnumValueA" ( _
ByVal HKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcbValueName As Long, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Byte, _
lpcbData As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
ByVal HKey As Long) As Long
Public Function GetPrinterFullNames() As String()
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long ' index into Printers()
Dim HKey As Long ' registry key handle
Dim Res As Long ' result of API calls
Dim Ndx As Long ' index for RegEnumValue
Dim ValueName As String ' name of each value in the printer key
Dim ValueNameLen As Long ' length of ValueName
Dim DataType As Long ' registry value data type
Dim ValueValue() As Byte ' byte array of registry value value
Dim ValueValueS As String ' ValueValue converted to String
Dim CommaPos As Long ' position of comma character in ValueValue
Dim ColonPos As Long ' position of colon character in ValueValue
Dim M As Long ' string index
' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)
' open the key whose values enumerate installed printers
Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
KEY_QUERY_VALUE, HKey)
' start enumeration loop of printers
Res = RegEnumValue(HKey, Ndx, ValueName, _
ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until Res = ERROR_NO_MORE_ITEMS
M = InStr(1, ValueName, Chr(0))
If M > 1 Then
' clean up the ValueName
ValueName = Left(ValueName, M - 1)
End If
' find position of a comma and colon in the port name
CommaPos = InStr(1, ValueValue, ",")
ColonPos = InStr(1, ValueValue, ":")
' ValueValue byte array to ValueValueS string
On Error Resume Next
ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
On Error GoTo 0
' next slot in Printers
PNdx = PNdx + 1
Printers(PNdx) = ValueName & " on " & ValueValueS
' reset some variables
ValueName = String(255, Chr(0))
ValueNameLen = 255
ReDim ValueValue(0 To 999)
ValueValueS = vbNullString
' tell RegEnumValue to get the next registry value
Ndx = Ndx + 1
' get the next printer
Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _
0&, DataType, ValueValue(0), 1000)
' test for error
If (Res <> 0) And (Res <> ERROR_MORE_DATA) Then
Exit Do
End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
Res = RegCloseKey(HKey)
' Return the result array
GetPrinterFullNames = Printers
End Function
Sub Auto_Open()
Dim start As Date
Dim weekcom As Date
Dim today As Date
start = Sheets("MainAssembly").Range("F3").Value
today = Sheets("MainAssembly").Range("F7").Value
weekcom = start
Do While weekcom < today
weekcom = weekcom + 28
Loop
Sheets("MainAssembly").Range("F6").Value = weekcom
Dim Printers() As String
Dim N As Long
Dim S As String
Dim col As String
Dim bw As String
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
S = Printers(N) 'S & Printers(N) & vbNewLine
If InStr(S, "Microsoft") <> 0 And InStr(S, "Print") <> 0 Then col = S
If InStr(S, "HP Photosmart Wireless B109n-z") <> 0 And InStr(S, "Print") = 0 Then bw = S
Next N
Sheets("MainAssembly").Range("F8").Value = col
Sheets("MainAssembly").Range("F9").Value = bw
MsgBox col, vbOKOnly, "Colour Printer"
MsgBox bw, vbOKOnly, "BW Printer"
End SubEz pedig elvégzi a piszkos munkát:
Sub EOM_Main_Assy_Workbooks()
'loop:
Dim sPath As String, ssheet As String, fileName As String
Dim lastrow As Long, counter As Long
Dim ws As Worksheet, tp As Worksheet, ma As Worksheet
'printers:
Dim bw As String, col As String
'from main worksheet:
Dim sDate As String
Dim sWeek As String
Dim sWkcom As String
Dim nextmonth As Date
'from Table:
Dim freq As String
Dim area As String
Dim loc As String
Dim dat As String
Dim week As String
Dim wkcom As String
Dim procloc As String
Dim procname As String
Dim machloc As String
Dim machname As String
Dim printer As String
Dim copies As Integer
Dim saveandclose As String
sDate = "=[FillerPrinter.xlsm]MainAssembly!$F$4"
sWeek = "=[FillerPrinter.xlsm]MainAssembly!$F$5"
sWkcom = "=[FillerPrinter.xlsm]MainAssembly!$F$6"
Set ma = Workbooks("FillerPrinter.xlsm").Worksheets("MainAssembly")
nextmonth = ma.Range("F4")
col = ma.Range("F9")
bw = ma.Range("F9")
Set ws = Workbooks("FillerPrinter.xlsm").Worksheets("OpenClose")
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
counter = 2
Do While counter <= lastrow
ws.Activate
freq = Range("A" & counter)
area = Range("B" & counter)
loc = Range("C" & counter)
sPath = Range("D" & counter)
ssheet = Range("E" & counter)
dat = Range("F" & counter)
week = Range("G" & counter)
wkcom = Range("H" & counter)
procloc = Range("I" & counter)
procname = Range("J" & counter)
machloc = Range("K" & counter)
machname = Range("L" & counter)
printer = Range("M" & counter)
copies = Range("N" & counter)
saveandclose = Range("O" & counter)
'freq check
Select Case CStr(freq)
Case "4 weekly"
GoTo openworksheets
Case "monthly"
GoTo openworksheets
Case "2 monthly"
Select Case Month(nextmonth)
Case 1, 3, 5, 7, 9, 11
GoTo openworksheets
Case Else
GoTo nextraw
End Select
Case "3 monthly"
Select Case Month(nextmonth)
Case 1, 4, 7, 10
GoTo openworksheets
Case Else
GoTo nextraw
End Select
Case Else
GoTo nextraw
End Select
'open sheets
openworksheets:
Workbooks.Open sPath
fileName = Right(sPath, Len(sPath) - InStrRev(sPath, "\"))
'update sheets if necessary
Set tp = Workbooks(fileName).Worksheets(CStr(ssheet))
If CStr(dat) <> "" Then
Sheets(ssheet).Select
Range(dat).Select
ActiveCell.Formula = sDate
End If
If CStr(week) <> "" Then
Sheets(ssheet).Select
Range(week).Select
ActiveCell.Formula = sWeek
End If
If CStr(wkcom) <> "" Then
Sheets(ssheet).Select
Range(wkcom).Select
ActiveCell.Formula = sWkcom
End If
If CStr(procloc) <> "" Then
Sheets(ssheet).Select
Range(procloc).Select
ActiveCell.Formula = procname
End If
If CStr(machloc) <> "" Then
Sheets(ssheet).Select
Range(machloc).Select
ActiveCell.Formula = machname
End If
'print sheets
Select Case CStr(printer)
Case "col"
Application.ActivePrinter = col
tp.PrintOut copies:=CStr(copies)
Case "bw"
Application.ActivePrinter = bw
tp.PrintOut copies:=CStr(copies)
Case Else
MsgBox "No printer selected"
End Select
'wait here a bit
Do While ActiveWindow.View = xlPrint
Loop
'time to save&close
If CStr(saveandclose) = "yes" Then
Excel.Workbooks(fileName).Close SaveChanges:=True
Else: GoTo nextraw
End If
nextraw:
counter = counter + 1
Loop
Worksheets("MainAssembly").Select
Range("A1").Select
MsgBox "Done!"
End SubEz nem az összes workbook, amivel foglalkoznom kell, de egyelőre tesztnek elegendőek ezek is. Jelenlegi formájában a kód 88 sheetet kevesebb, mint 2 perc alatt megnyitott, update-elt, nyomtatóra küldött, majd bezárt
Már csak szűrést és hibakezelést kellene beleszőnöm valahogy.
Az egész csoportnak köszönöm mégegyszer az eddigi segítséget -
eszgé100
őstag
válasz
Pakliman
#47879
üzenetére
Do While ActiveWindow.View = xlPrint
'Application.Wait (Now + TimeValue("00:00:01"))
LoopElőször Application.Wait-tel próbáltam, de még az is felesleges a boldogsághoz
Egyelőre csak itthon tudtam kipróbálni, majd hétfőn meglesem melóban is, hogy a valóságban is működik-e? -
eszgé100
őstag
válasz
Delila_1
#47877
üzenetére
Köszönöm, de nem pontosan ilyen formában kerestem a duplikációt.
Van egy vba ciklusom, fentről lefelé halad, ezért nem releváns, hogy a tartomány felső részében található-e a duplikáció, lényeg, hogy a maradékban ne legyen, erre tökéletes volt Pakliman formulája, szerencsére működik ez is automatikusan, ha táblává alakítom. egyébként örök hálám az ötletért, megmentettél egy kör guglizástól Valós felhasználása egyébként az lesz, hogy B oszlopban lesznek elérési útvonalak, többi oszlopban különböző paraméterek a ciklusnak, és az utolsó oszlopban lesznek tárolva a válaszok a Save&Close-ra. Ha az adott fájlt később még használja a ciklus, akkor nyitva hagyom (válasz no), ha nem akkor mentés és zárás (yes), példában pont fordítva kérdeztem, de az már csak részletkérdés.
Ezzel kapcsolatban meg is érkeztem ma esti fejtörőmhöz:
Ciklusomban egy bizonyos ponton elérkezek a nyomtatáshoz
Select Case CStr(printer)
Case "col"
Application.ActivePrinter = col
tp.PrintOut copies:=CStr(copies)
Case "bw"
Application.ActivePrinter = bw
tp.PrintOut copies:=CStr(copies)
Case Else
MsgBox "No printer selected"
End SelectMajd ezután megvizsgálom, hogy Save&Close "yes"-e?
If CStr(saveandclose) = "yes" Then
Excel.Workbooks(fileName).Close SaveChanges:=True
Else: GoTo nextraw
End If
Itt kezdődnek a bajok, a kettő közé kellene valami, ami megakasztja a cilkus további futását, amíg ez az ablak be nem záródik.
Ugyanis, ha várni kell a nyomtatóra valamiért, akkor az ciklus egyszerűen bezárja a fájlom még mielőtt el lett volna küldve a nyomtatóra.
Próbáltam ezt, wordben ok, de sajnos excelben nem működik:
While Application.backgroundPrintingStatus > 0
Application.Wait (Now + TimeValue("00:00:01"))
WendSimán Application.Wait-et sem akarok használni, mert akkor 1000 évig tartana, míg végez a ciklus, plusz azt sem tudom mennyi időt kellene pontosan meghatároznom.
-
eszgé100
őstag
Én is darabtelivel szórakozok:
B1 képlete: =IF(COUNTIF(A1:A$7,A1)>1,"yes","no")
A vastaggal kiemelt részt hogyan tudnám változtatni annak függvényében, hogy beviszek-e újabb adatot A8-ba?
Valami hasonlóra gondolok:
=IF(COUNTIF(A1:A&lastrow,A1)>1,"yes","no")Egyszer már véletlenül kigugliztam, de ma az istenért sem találom.
-
-
eszgé100
őstag
válasz
Fferi50
#47752
üzenetére
köszönöm szépen, az első megoldás a befutó egyelőre, viszont még gondolkozok fire/SOUL/CD formuláin is.
fire/SOUL/CD: köszönöm neked is, adtál egy extra ötletet, a "nem hétfő van éppen" kiegészítéssel. A feladat, hogy egy, a korábbi hsz-emben található munkalap variációi minden 4. hétfő reggelre ki legyenek nyomtatva, a megfelelő dátumokkal és hét számozással. Ez a valóságban leggyakrabban úgy néz ki, hogy valamelyik korábbi hét folyamán ki vannak nyomtatva (ez általában a közvetlen korábbi hét, de lehet, hogy 2 vagy akár 3 héttel korábbi is) és aztán a péntek éjjeles mikor teljesen kitöltötte az összes mezőt az aktuális lapon, bekészít egy új lapot hogy a hétfő reggeles már tudja használni, a régit pedig archiválja. A nem hétfő van éppen kifejezés akkor jönne jól, ha valami oknál fogva csak hétfő kora reggel lennének kinyomtatva, és az már a nagyon sürgős pillanat, mert addigra már mindenkinek kell egy friss.
Tehát a cella értéke, amit keresek, ha pl 01/01/2022-től indulok, akkor az év első hétfője, majd az azt követő minden 4. hétfő. Ha a dátum már túlment rajta, akkor a cella frissüljön a következő 4. hétfő dátumára.
-
eszgé100
őstag
válasz
Fferi50
#47747
üzenetére
köszönöm, eddig jutottam a dologgal:
A következő 4. hétfőt egy egyszerű makróval számoltam ki:Sub weekcomupdate()
Dim start As Date
Dim weekcom As Date
Dim today As Date
start = Range("C2").Value
today = Range("D2").Value
weekcom = start + 28
Do While weekcom < today
weekcom = weekcom + 28
Loop
Range("E2").Value = weekcom
End SubA hét számát pedig isoweeknum-mal. Meg lehetne oldani, hogy a makró tartalmát formulává tudjam konvertálni és beilleszteni az E2-es cellába?
-
eszgé100
őstag
01/06/2021-nél szintén bukik a dolog, mert májusban 5 hétfő volt, de legalább a januári problémát megoldja.
Egy munkafüzetem, aminek az alkotója valamiért úgy gondolta, hogy 4 hetes periódusban legyen vezetve, viszont csak a sz.pás van vele mind az update-kor, mert nem lehet egyszerre letudni a többivel, amikkel 1-2-3-6-12 havonta kell csak foglalkozni, mind pedig az archiváláskor, mert minden dosszié ugyanígy havi-12 havi rendszerességre van kitalálva.
Szóval e bizonyos munkafüzet miatt muszáj tartani a 4. hétfőket. Ez csak a master, ennek van kb. 80 különböző verziója, de mindegyik ugyanígy működik.
-
eszgé100
őstag
Week és Week commencing-et szeretném meghatározni.
First Monday of CY =DATE(YEAR(F4),1,8)-WEEKDAY(DATE(YEAR(F4),1,6))
1st of next month =EOMONTH(TODAY(),0)+1Week értéke egyenlő minden 4. hétfővel, az év első hétfőjétől kezdve, ezesetben 04/01/2021=1, 01/02/2021=5, 01/03/2021=9, 29/03/2021=13
Week commencing, lenne a dátuma az előzőleg meghatározott 4. hétfőknek
Ideális esetben Week mindig páratlan szám lenne (1-5-9-13...), de =DATEDIF(B1,B2, "d")/7 nem alkalmas, nem beszélve a januárról, ahol az első hétfő általában később esik 01/01/yyyy-nál, ahol hibát okoz.
Van ötletetek mit használjak helyette?
-
#47709
eszgé100
őstag
Fire/SOUL/CD
#47708
eszgé100
őstag
válasz
Fire/SOUL/CD
#47708
üzenetére
annyiban kellett módosítanom, hogy a 2 feltételre keressen.
Előző példánál maradva az itthon gépen "nyomtatóinak" listája:
viszont a kulcsszavam, amit keresek "Microsoft" -> BW nyomtató
"Microsoft Print" -> Col nyomtató
Mivel a Microsoft mindkét esetben előfordul, ezért a két változó egyforma eredményt hozott.Így már tökéletes:
Sub Testprinters()
Dim Printers() As String
Dim N As Long
Dim S As String
Dim Col As String
Dim BW As String
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
S = Printers(N) 'S & Printers(N) & vbNewLine
If InStr(S, "Microsoft") <> 0 And InStr(S, "Print") <> 0 Then Col = S
If InStr(S, "Microsoft") <> 0 And InStr(S, "Print") = 0 Then BW = S
Next N
MsgBox Col, vbOKOnly, "Colour Printer"
MsgBox BW, vbOKOnly, "BW Printer"
End SubNagyon szépen köszönöm a segítséged
-
#47707
eszgé100
őstag
Fire/SOUL/CD
#47705
eszgé100
őstag
válasz
Fire/SOUL/CD
#47705
üzenetére
írtam is, hogy ezt az itthoni gépemen próbáltam, ezért nem ugyanaz a telepített nyomtatók listája, de ha az elv jó, akkor csak a "XPS" és "PDF"-et, mint keresési feltételt kell kicserélnem majd a megfelelő kulcsszavakra.
-
#47702
eszgé100
őstag
Fire/SOUL/CD
#47661
eszgé100
őstag
válasz
Fire/SOUL/CD
#47661
üzenetére
Itthoni gépen ez az eredmény:
Amennyiben az XPS... on Ne00: szeretném beállítani színesre és a PDF on Ne01:-et fekete-fehérre, akkor elég az alábbiak szerint módosítanom a kódot, vagy van még valami, amire külön oda kellene figyelnem?
Sub Testprinters()
Dim Printers() As String
Dim N As Long
Dim S As String
Dim Col As String
Dim BW As String
Printers = GetPrinterFullNames()
For N = LBound(Printers) To UBound(Printers)
S = Printers(N)
If InStr(S, "XPS") Then Col = S
If InStr(S, "PDF") Then BW = S
Next N
MsgBox Col, vbOKOnly, "Colour Printer"
MsgBox BW, vbOKOnly, "BW Printer"
End SubCol és BW lesz a két nyomtató teljes neve.
Megnézem, hogy S tartalmazza-e az XPS vagy PDF kifejezést az adott ciklusban majd a végén kiíratom, hogy talált-e egyezést, ha valamelyik MsgBox üres, akkor sz.r van a palacsintában.
A cilkus elejéről még módosítottam az S-t, hogy mindig csak az aktuális nyomtató neve legyen benne, és ne adódjanak össze a ciklus végére. -
#47662
eszgé100
őstag
Fire/SOUL/CD
#47661
eszgé100
őstag
válasz
Fire/SOUL/CD
#47661
üzenetére
Koszonom, holnap reggel kiprobalom
-
eszgé100
őstag
Sziasztok!
Van két változóm, amiben a színes és a fekete-fehér nyomtató hálózati címét tárolom.
Jelenleg így néz ki:bwprinter = "\\HPFDDA3F (HP Photosmart C4500 series) on Ne02:"
colprinter = "\\HP Photosmart Wireless B109n-z on Ne03:"majd, ahogy fut a kód úgy változtatom Application.ActivePrinter = colprinter vagy Application.ActivePrinter = bwprinter -re, attól függően, hogy az adott munkalapot színesben vagy fekete-fehérben szeretném nyomtatni.
A kód remekül működik, amennyiben egy adott gépen használom, viszont ha máshol ülök le a változó a portszámok miatt mindig a a kódban kell túrkálnom, hogy változtassam. Nekem nem nagy ügy, de így nem merem kollégáimra rábízni.
Szeretnék egy-egy gombot a színes és fekete-fehér nyomtatónak, amikkel megjelenne a nyomtatóválasztó és kiválasztva az adott nyomtatót eltárolnám a fenti két változómba, portszámmal együtt, még mielőtt maga a nyomtatási makró elkezdene lefutni.
Előre is köszönöm, ha tudtok ebben segíteni.
-
#45149
eszgé100
őstag
Fire/SOUL/CD
#45148
eszgé100
őstag
válasz
Fire/SOUL/CD
#45148
üzenetére
gyönyörű, nagyon szépen köszönöm.
a "cancel=true"-t láttam kb 15x a mai nap folyamán, de nem értettem meg a lényegét.
gondolom a jövőben sokat segítene rajtam az is, ha legalább a kérdésem normálisan meg bírnám fogalmazni -
#45147
eszgé100
őstag
Fire/SOUL/CD
#45138
eszgé100
őstag
válasz
Fire/SOUL/CD
#45138
üzenetére
Szia, köszönöm szépen.
5 embernél valóban nem sok értelme van, de kb 100 ember betanulását 80 munkafolyamaton kellene így nyomonkövetni, ezért gondoltam, hogy a dupla klikkes megoldás gyorsabb.VBA-ban jelenleg ezt kellene finomhangolni:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Value = 0 ThenActiveCell.Value = 25Range("A1").SelectElseIf Target.Value = 25 ThenActiveCell.Value = 50Range("A1").SelectElseIf Target.Value = 50 ThenActiveCell.Value = 75Range("A1").SelectElseIf Target.Value = 75 ThenActiveCell.Value = 100Range("A1").SelectElseIf Target.Value = 100 ThenActiveCell.Value = 0Range("A1").SelectEnd IfEnd SubFeltételes formázáskor csak az ikont megjelentítve szépen ugrál szeletről-szeletre, de muszáj volt a kijelölést elmozdítanom, különben loop lenne belőle. Ebből a "Range("A1").Select"-re jobb lenne valami más, mert ez csak addig okés, míg nem kell görgetni, legjobb lenne, ha ugyanazon a cellán maradna a kijelölés, valamint az egész Sheet1 helyett csak egy adott tartományban működjön a duplaklikk.
-
eszgé100
őstag
Sziasztok!
Conditional formattinggal kapcsolatban kérdeznék
A3:AE3 rangeben vannak az adott hónap dátumai, hónap első napja AG1 cellában. A3=AG1, A2=A3+1 stb. A4:AE22-ben ugyanazok a dátumok elrejtve.
Weekday-jel sikerült automatikusra állítani a hétvégék kiszürkítését.
AI29:AI32 és AK29:AK32-ben vannak a munkaszüteni napok.Hogyan tudnám ezt beállítani, hogy ha A3:AE22 rangeben ugyanaz a dátum szerepel, mint a munkaszüneti napoknál, akkor az kisárguljon automatikusan?
-
eszgé100
őstag
válasz
zsolti_20
#44578
üzenetére
Szia, csak az elsőre van ötletem, mert épp most csinálok hasonlót
Public Sub CopyThenDelete()Workbooks.Open "Z:\Excel\egyik.xlsm"Workbooks("egyik.xlsm").Worksheets("Sheet2").Range("A1:A10").copy Workbooks("másik.xlsm").Worksheets("Sheet4").Range("B2")Workbooks("egyik.xlsm").Close SaveChanges:=FalseKill "Z:\Excel\egyik.xlsm"End Suba makrót a másik.xlsm-ből kell indítani. Workbooks.open... sor nem kell, ha már alapból is nyitva van az egyik.xlsm munkafüzet.
Kill-el vigyázz, mert véglegesen töröl, nem a lomtárba. Biztonság kedvéért csinálj biztonsági mentéseket az érintett fájlokról -
-
eszgé100
őstag
válasz
Fferi50
#44543
üzenetére
vegyesen vannak excel és word fájlok is, nagy része excel fájl (kb. 60) és 4-5 word dokumentum összesen.
Ahogy láthatod, a sok guglizás olyan kódot eredményez, mintha Gyűrűk urát fordítanék Google Translate-tel.A fenti példa azt mutatja, hogy Excelben lenyomok egy Buttont, ami a háttérben megnyitja a Word alkalmazást, abban egy Word dokumentumot, és lefuttatja a benne levő makrókat, majd az Excel 1 másodperc várakozás után bezárja a Wordot alkamazást, nem ment semmit, végén Excel nyitvamarad.
kipróbáltam, nem kell a CreateObject("Excel.Application") simán Application.Wait elég a várakozáshoz.
"Én egy alap Excelt használnék"
Magyarul ha jól értelmezem, akkor kell csinálni egyetlen .xlsm fájlt, benne Print(xy.xls) makrókat, a változó fájlnevekkel, nyomtatási területekkel és oldalbeállításokkal beállításokkal? Elvileg csak a makrók futtatásához kell megnyitni a fájlokat, ha azokban vannak elmentve, nyomtatáshoz nem, így megsprórolom a fájlok külön megnyitogatását is, ugye?
-
eszgé100
őstag
válasz
Fferi50
#44540
üzenetére
minden .xls-be beleirom az hozza tartozo makrokat (pl: melyik terulet milyen lapokat hasznal, automatikus formazasok, a szombat-vasarnapokra stb) aminek abban a dokumentumban le kell futnia. Nagyja csak a nyomtatasi beallitasokat fogja tartalmazni, nehanyban kell csak formazni a cellakat. Mikor ez megvan, ezekre irni egy olyan makrot, ami megnyitja az adott xls-t es lefuttatja a makrokat, majd bezarja. Lehet ez az utolso resze nem fog menni a halozat biztonsagi beallitasai miatt, de majd ezt meg a heten kideritem
-
eszgé100
őstag
válasz
eszgé100
#44488
üzenetére
vetne erre valaki egy pillantást?
fenti problémát szeretném még mindig megoldani, a változókat szépen összelinkelem egy dokumentumból, valamint ugyanebben a dokumentumban elhelyezek egy Gombot, ami lefuttat valami hasonlót:
Sub Open_Word_Document()Set objWord = CreateObject("Word.Application")objWord.Documents.Open "Z:\Excel\ALBÉRLET.docm"objWord.Visible = FalseobjWord.Application.Run "NewMacros.toprint"CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:01"))objWord.Quit SaveChanges:=objWordsDoNotSaveChangesSet objWord = NothingEnd SubA word doksiban pedig lefutnak ezek a makrók:
Sub kicsi()'' kicsi Macro''Selection.WholeStorySelection.Font.Size = 10End SubSub toprint()'' toprint Macro''Dim strCurrentPrinter As StringstrCurrentPrinter = Application.ActivePrinterApplication.Run MacroName:="kicsi"Application.ActivePrinter = "HPFDDA3F (HP Photosmart C4500 series)"Application.PrintOut Range:=wdPrintAllDocument, Copies:=1Application.ActivePrinter = strCurrentPrinterEnd SubTermészetesen csak egy példa, ami nagyjából azt demonstrálja, hogy egy gombnyomásra a háttérben megnyíljon a Word/Excel, lefuttasson adott makrókat majd azt egy megadott nyomtatóra elküldje, és mentés nélkül zárja be.
Ezen kívül kell még szerintetek nekem valami, mielőtt nekiállok linkelni a doksikat és nagyüzemben makrókat írni hozzájuk?
-
eszgé100
őstag
Sziasztok!
Főnököm rámsózott egy halom excel fájlt, hogy havi szinten rendezzem őket, de a jelenlegi állapotuk idegileg összerongál. Cégnél Excel 2016-ot használunk, hálózathoz van egy egyszerű login+jelszó kombóm, semmi extra.
Alapfelállás: adott egy gyártósor, ahol egy adott műszakban dolgozik egy groupleader, 4 teamleader és 17 melós + plusz én, aki középiskola óta nem foglalkozott excellel meg programozással. Mindenkinek megvannak a napi műszakkezdési és műszakvégi elleőrzőlistái, plusz a szerszámoknak, emelőknek, csavarozó-, ragasztó-, minőségellenőrző gépeknek
Ezek a papírok összesen kb. 60(?) különböző dokumentumban találhatóak eredetileg, különböző nyomtatási beállításokkal (A3, A4, színes, fekete-fehér, két oldalas stb.), valamint univerzálisak, egy dokumentumból csak néhány munkalap ami hozzánk tartozik, a többit más területek használják.
Ezeknek a nagyrészében a legtöbb változó ugyanaz (pl: dátum, hányadik hét, ciklusidő stb), de valamiért ezeket egyesével kelleme átírnom, amire lehet, hogy a fönökömnek volt ideje, meg lehet nekem is lenne, de kedvem az zéró.
Kérdésem, hogyha csinálok egy új excel dokumentumot benne, csak a változókkal (mint ahogy egy egyszerű programot kezd az ember) és az adott cellákat belinkelem a céldokumentumba pl. ilyen formában:
='C:\Excel\[változók.xlsx]Munka1'!$A$1='C:\Excel\[változók.xlsx]Munka1'!$A$2az megoldaná a problémáim, vagy van ennek valami szebb módja?
Már ez jelentősen lecsökkentené az erre szánt túlóráim számát, viszont ha le lehetne programozni valahogy azt is, hogy a nyomtatás nagyjából automatikus legyen, akkor lenne csak nagy az örömöm. Teljesen minden milyen programnyelven, mert ígyis-úgyis meg kellene tanulni, időkeret korlátlan, viszont ha ezt le tudnám automatizálni, akkor azzal hatalmas jópontot szerezhetnék. Ezügyben melyik topikban kellene érdeklődnöm, ha ezirányú kérdésem nem ide való?
Előre is köszönöm
,"<>")),D2)>1,"no","yes") függvénnyel van meghatározva, ami eddigi tesztjeim alapján dinamikusan változik, amikor ugyanaz az elérési útvonal kerül a Path oszlop celláiba. Amennyiben az adott elérési útvonal nem ismétlődik többet a maradék cellatartományban az érték Save&Close "yes"-re változik és a workbook ment és bezárul
Új hozzászólás Aktív témák
Hirdetés
- Milyen légkondit a lakásba?
- Azonnali VGA-s kérdések órája
- CPU léghűtés kibeszélő
- Nem indul és mi a baja a gépemnek topik
- AMD Ryzen 9 / 7 / 5 / 3 5***(X) "Zen 3" (AM4)
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Bemutatkozott a Poco X7 és X7 Pro
- HDD probléma (nem adatmentés)
- Robotporszívók
- Ingatlanos topic!
- További aktív témák...
- Csere-Beszámítás! RGB Számítógép PC játékra! R5 5600X / RTX 3060Ti 8GB / 32GB DDR4 / 500GB SSD
- PlayStation Plus Premium előfizetés 3291 Ft / hó áron!
- ÁRGARANCIA!Épített KomPhone Ryzen 7 5800X 32/64GB RAM RX 7700 XT 12GB GAMER PC termékbeszámítással
- DELL PowerEdge R640 rack szerver - 1xGold 6138 (20c/40t, 2.0/3.7GHz), 64GB RAM,4x1G RJ, HBA330, áfás
- ÁRGARANCIA!Épített KomPhone Ryzen 7 9800X3D 64GB RAM RTX 5080 16GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: PC Trade Systems Kft.
Város: Szeged