Az „Excel” fórum célja, hogy keretet adjon az Excel felhasználók széles táborának tapasztalataik megosztására, és lehetőséget a segítséget kérőknek. Az alábbi összefoglaló azért készült, hogy segítse a helyes kérdésfeltevést.
– Írd le szabatosan a problémát. Úgy fogalmazz, hogy ne csak te magad, de a szakértő is megértse, mire szeretnél választ kapni.
– Írd le, hogy milyen verziójú Excellel dolgozol. (Vagy ha nem – ill. nem csak – Excel, akkor micsoda?)
– Írd le, hogy milyen úton indultál el, és hol akadtál el rajta.
– A kérdés megértése szempontjából sokat segíthet, ha feltölteszt egy képet, amin látszik, hogy mit szeretnél, vagy illusztrálja azt.
– Még jobb, ha feltöltesz egy minta munkafüzetet valahová (pl. data.hu). Feltöltés előtt távolítsd el belőle a nem publikus adatokat.
– Ha a feladat jellege olyan, célszerű az "előtte" és "utána" állapotokat bemutatni. (Miből kellene csinálni mit?)
– Ha VBA kódon kell javítani, másold be a releváns kódrészt. Rövid kód mehet hozzászólásba, hosszú kód inkább ide: http://pastebin.com/
– Ha valami nem úgy működik, ahogy kellene, add meg a rendellenes viselkedés jellemzőit, a hibaüzenetet, és a hibát okozó programsort.
Szerintem egy elfelejtett utasítás lesz minden baj forrás!
Ami feltétlenül szükséges előkészület:
Egy képen csináld meg méret helyreállítását. Ez azért kell, hogy amikor legközelebb feljön a Megjegyzés formázása ablak, akkor a Méret fül legyen felül.
Nagyon értékelem az igyekezeted de ez nem lesz jó. Azt is megmondom miért. Félrevezető lehet, hogy a feltöltött minta.xls csak 2 oszlopot és 5 sort tartalmaz de a valóságban 10 oszlop van és 2000 sor így 2000-nél is több képet kellene egyesével átállítanom. Ez még a korábban működő makrónak is ~1-2 percbe tellett. OK, értem - csak egyszer kell megcsinálni - de a képek mérete azt hiszem attól szokott elállítódni ha szűröm a cellákat valamilyen feltétel szerint vagy másik oszlop szerint rendezek sorba, továbbá egyes cellákat néha törlök vagy más munkafüzetbe kerülnek át így nem hiszem, hogy ez a megoldás (kielégítően) működne. A 34517-esbe beillesztett makrón semmit nem változtattam. Sokáig működött (egyszer csak nem) ezért gondoltam, hogy létezik megoldás, de sajnos úgy tűnik ez most mindenkin kifog. És csak ismételni tudom magam, hogy nagyon értékelem az igyekezeted, hogy időt szántál rám de valami praktikusabb megoldás kellene. Még egyszer köszönöm!
Az alsó makróban nem kell a cm.Visible = True sor, hiszen a makró elején az Application.DisplayCommentIndicator = xlCommentAndIndicator láthatóvá tette az összes megjegyzést.
Egyszer kell megcsinálnod. Tedd láthatóvá a megjegyzéseket, a nem jó méretűeket méretezd át egérrel.
Futtasd le az Eredeti_meret makrót. Ez beírja a C és D oszlopokba a szélesség és magasság méreteket. Teheted a méreteket más oszlopokba is, de akkor a második makrónál is azt kell alkalmaznod.
úgy látszik fejlődöm, mert mielőtt olvastam volna a válaszod ezt műveltem:
Sub Megjegyzes()
Dim sh As Shape, cm As Comment For Each cm In ActiveSheet.Comments cm.Visible = True Set sh = cm.Shape sh.Select Selection.AutoSize = True cm.Visible = False Next
End Sub
Itt már nem jelez hibát, lefut a makró de nem azt teszi, amit kellene.
Az összes kép méretet kicsire állítja, de érzem, hogy jó fele tapogatózunk.
Egyetlen makróra lenne szükségem és mivel csak ez az egy érdekel nem szántam magam rá a Visual Basic mélyebb elsajátítására így külső segítségre van szükségem. Korábban kb. 10 éve valamelyikőtök már segített ebben és írt egy rövid makrót, ami évekig remekül működött de egy ideje már nem működik. (a bánat tudja miért pedig nem tudok róla, hogy bármit változtattam volna rajta)
- Office 2003-at használok (nem tévedés... 2003) - a megjegyzésekbe képeket ágyazok a következő módon:
01 cella kijelöl 02 egér jobb klikk 03 megjegyzés beszúrása 04 megjelenő ablak keretére dupla klikk 05 színek és vonalak (lenyíló fül) 06 szín 07 kitöltési effektus 08 kép 09 képválasztás 10 beszúrás 11 ok 12 ok 13 ablak keretére dupla klikk 14 méret 15 alaphelyzet 16 ok
Innentől ha a cella fölé viszem az egérmutatót a beágyazott kép előugrik. A gond csak az, hogy időnként valamilyen ok miatt a képek méretének alaphelyzete elállítódik és egyesével visszaállítani óriási és felesleges munka lenne mivel újra el fog állítódni. Ez nem is lenne baj, mert a makró meg tudja ezt oldani pillanatok alatt(ha van). A képek mérete eltérő. Nem nagyok de az oldalarányaik eltérőek.
Tehát a feladat röviden az lenne, hogy egy makró az aktív munkafüzetben alaphelyzetbe állítsa a beágyazott képek méreteit.
példának okáért idemásolom azt a makrót a neve "Sub Megjegyzem", ami már nem működik hátha valaki észreveszi mi lehet a hiba és azt átírva megoldódik a probléma de lehet, hogy tudnátok jobb megoldást, nekem mindegy.
*********************************************** Sub Megjegyzem() Dim sh As Shape, cm As Comment, i As Long For i = 1 To 2 For Each cm In ActiveSheet.Comments cm.Visible = True Set sh = cm.Shape sh.Select DoEvents Application.SendKeys "^1" Application.SendKeys "{TAB}" Application.SendKeys "{TAB}" Application.SendKeys "{TAB}" Application.SendKeys "{TAB}" Application.SendKeys "{TAB}" Application.SendKeys "{TAB}" Application.SendKeys "{TAB}" Application.SendKeys "{ENTER}" Application.SendKeys "{TAB}" Application.SendKeys "{ENTER}" cm.Visible = False Next Next End Sub
Köszönöm a kérdést. Nem ez volt ugyan a megoldás, de adtál egy inspirációt. Megtaláltam az eltérés okát.
Az eredmény megdöbbentő, váratlan és tanulságos:
Kezdem azzal, hogy a végrehajtás sorrendje mégsem tér el a két helyen. Az csak a látszat volt. Egészen pontosan először végrehajtódik a BeforUpdate, aztán a cmdMegse_Click, majd rejtélyes okból ismét a BeforeUpdate. Csak baromi nehéz követni őket, mert olyanok, mint a kvantumrészecskék. Ha megfigyelem őket (jelen esetben megszakítom a futást, és lépésenként nézem), akkor másképp viselkednek. Debug.print "Itt vagyok" és hasonló beszúrásokkal lehet valamennyire nyomon követni a bejárt utat.
Szóval az a bizonyos Mégse nevű CommandBoxra kattintás volt a kulcsa a dolognak. A "rosszul viselkedő" Userformon magát a cmdMegse gombot szépészeti okokból az oldal alján középre helyeztem el. Amikor a textbox beadást nem félbehagyom, hanem befejezem, akkor beforaUpdate-ban kiíratom mellé a mentést lehetővé tevő cmdMentes gombot. De hogy szép maradjon az utóbbit középtől kicsit balra, a cmdMegse gombot ugyanennyivel kicsit jobbra igazítom a cmdMegse.left = xxx paranccsal.
És ez volt az eltérés oka! Úgy látszik, hogy ezt a kis elmozdulást értelmezte úgy a program, hogy ha már elment onnan akkor nem is kell végrehajtani. (Emberi kapcsolatokból sok példa van erre: Ha nem várt meg, akkor az ő baja...)
Abban a pillanatban, amikor ezt a parancsot töröltem, a cmdMegse rendben végrehajtódott.
Van két Userformom. Mindkettő egy Textbox kitöltésével kezd, ahol egy elnevezést kell megadni. Ebből a név megadás befejezésével (Enter/Tab) lehet kilépni, vagy a Mégse nevű CommandBoxra kattintva. Szeretek arra felkészülni, hogy ha a felhasználó a név megadása közben meggondolja magát, és a Mégse gombra kattintva félbe akarja hagyni a megkezdett munkát, mert mondjuk most vette észre, hogy nem erre a Formra akart lépni.
Elvileg (hitem szerint) azonosak a feltételek, mégis az egyiknél - a Mégse eseményre ugrás előtt - befejezi a névhez tartozó kilépés előtti ellenőrzést, a BeforeUpdate eseményt, a másiknál előbb a cmdMegse_Click eseményre ugrik a vezérlés, és csak aztán a BeforeUpdate-ra (a szándékom mindkettőnél az utóbbi lenne).
(Sajnos a BeforeUpdate eseményt nem tudom mással kiváltani, szükséges egy-egy Textbox beadása után, kilépés előtt bizonyos ellenőrzéseket elvégezni)
A kettő közti különbség azért nem mindegy, mert ha előbb lépek a Mégse eseményre, ott tudom jelezni a BeforeUpdate-nek (például egy .TAG-be írt üzenettel, hogy most nincs dolga az ellenőrzéssel.
Vajon mi lehet az általam észrevehetetlen különbség a kétféle lefutás között. Tudom, hogy a kód ismerete nélkül nemigen lehet erre válaszolni, de hátha valakinek volt hasonló megfigyelése, ahol kiderült a különbség.
Csatolt képen kékkel jelölt résszel akadt problémám. Kezdődik egy autó szűrővel. Jól működik a dolog egészen addig amíg a szűrésre van találat. Abban az esetben csak a találatokat kijelöli és másolja. Viszont ha nincs találat a szűrésre akkor a szűrés intervalluma alatti cellakat, több százezer sort is átmásolja. Van lehetőség beiktatni valami ha fuggvenyt, hogy amennyiben nincs a szűrésnek találata ne másoljon hanem hagyjon ki bizonyos lépéseket?
Letöltöttem ezt a filezilla cuccot, és - felhasználva némi netes szakirodalmat - elemezgettem az indulását.
Arra nem találtam infót, hogyan kell egyértelműen lekérdezni a Filezilla státuszát, viszont azt vettem észre, hogy a Filezilla processz egyes paraméterei az indítás után egy darabig változnak, aztán egy bizonyos értéken stabilizálódnak.
Ezekről van szó:
- PageFileUsage
- PrivatePageCount
- QuotaPagedPoolUsage
- ThreadCount
- VirtualSize
Úgy okoskodtam, hogy a stabilizálódáshoz szükséges idő valószínűleg a futtató hardver teljesítményétől és leterheltségétől függ, és ha már minden paraméter stabil, akkor a FileZilla biztosan tudja fogadni a SendKeys parancsokat.
Írtam tehát egy kódot, ami figyeli a fenti paraméterek értékét, és ha mind az 5 figyelt paraméter 10 egymást követő lekérdezés alatt stabilan állandó marad, akkor azt mondjuk, hogy az alkalmazás elindult.
Ha a 10-et soknak találod, lehet csökkenteni: csak állítsd át a CountQuery konstans értékét kisebbre.
A másik konstans egy biztonsági korlát, hogy ha N db (jelenleg 100) lekérdezés alatt sem állnak be a paraméterek, akkor álljon le a figyeléssel. Nálam mindig kb. 30 lekérdezés után stabilizálódott az 5 paraméter.
Sub FileZillaStarter() Const CountQuery = 10, QueryInterruptLimit = 100
Dim strComputer As String, objSWbemServices As Object, colServices As Object, objService As Object, myProp As Object, WshShell As String Dim arrProps, iQuery As Long, iProp As Long, StartOver As Boolean, CountTotalQueries As Long
strComputer = "." ReDim arrProps(1 To 5) Set objSWbemServices = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") WshShell = Shell("Elérési út\FileZillaPortable.exe", vbMinimizedFocus) Do StartOver = False For iQuery = 1 To CountQuery Set colServices = objSWbemServices.ExecQuery("select * from win32_process where name='FileZillaPortable.exe'") CountTotalQueries = CountTotalQueries + 1 Application.StatusBar = CountTotalQueries & " - " & CStr(StartOver) For Each objService In colServices iProp = 0 For Each myProp In objService.properties_ Select Case myProp.Name Case "PageFileUsage", "PrivatePageCount", "QuotaPagedPoolUsage", "ThreadCount", "VirtualSize" iProp = iProp + 1 If arrProps(iProp) <> myProp.Value Then arrProps(iProp) = myProp.Value StartOver = True End If End Select Next Next Next DoEvents Loop Until (StartOver = False) Or (CountTotalQueries > QueryInterruptLimit) If CountTotalQueries > QueryInterruptLimit Then MsgBox "belefáradtam a várakozásba" Else MsgBox "az Applikáció elindult és stabil" End If Application.StatusBar = False End Sub
Hangsúlyozom, hogy ez nem egy egzakt megoldás. Nem a tényleges státuszt kérdezem le, hanem különböző státusz-indikátorokat, amelyek vagy jól indikálnak, vagy nem.
Aztán az sem biztos, hogy más rendszereken lefut-e egyáltalán a kód. A saját Win7-es gépemen teszteltem, de ha pl. Win10 rendszeren a monitorozott processz-paraméterek neve más, és akkor máris nem fog működni.
Csak az egyértelműség kedvéért: a lenti kód megvárja, míg a filezilla elindul, és csak utána hajtja végre a következő műveletet. Ha jól értettem a korábbi posztokból, valami ilyesmire van szükséged.
Sub exampleIsProcessRunning() Dim WshShell As String WshShell = Shell("Elérési út\FileZillaPortable.exe", vbMinimizedFocus) While Not IsProcessRunning("FileZillaPortable.exe") Debug.Print "waiting - " & Now 'ez a sor törölhető, csak dísznek van Application.Wait Now + TimeSerial(0, 0, 0.1) 'ez a sor törölhető, csak dísznek van DoEvents 'ez a sor lehetővé teszi, hogy meg tudd szakítani a futást Crtl+Break segítségével, ha túl hosszúra nyúlna a végrehajtás (vagy ha végtelen ciklusba kerül a program) Wend MsgBox "process started OK" End Sub
Function IsProcessRunning(process As String) Dim objList As Object Set objList = GetObject("winmgmts:") _ .ExecQuery("select * from win32_process where name='" & process & "'") If objList.Count > 0 Then IsProcessRunning = True Else IsProcessRunning = False End If End Function
