- Rendszergazda topic
- Bocsánatot kért az Apple, mert nagyon mellélőtt a legutóbbi reklámjával
- Windows 11
- Már nem hisz a nagy európai EV-forradalomban a Ford
- Linux kezdőknek
- Padavan firmware
- ASUS routerek
- Elon Musk robottaxikat ígért Kínának
- ArchiCAD és Artlantis topik
- Megvédenék a gyerekeket az agresszív algoritmusoktól
Új hozzászólás Aktív témák
-
vilag
tag
válasz Delila_1 #2522 üzenetére
Nos, végre eljutottam odáig, hogy kipróbáljam.
Nem működik!
A vonalkód olvasó nem olvassa, pedig ez nem valami himpli-hampli 500 Ft-os vonalkódolvasó.Most úgy vagyok mint Edison az első 1000 villanykörténél, most már tudom, hogy ez a megoldás nem vezet a kívánt eredményre.
-
vilag
tag
Üdv!
Van egy újkeletű problémám:
A korábban említett vonalkód témához kapcsolódik.
Mint említettem is a Word esetében a betűtípus beágyazása csak többé-kevésbé működőképes megoldás, így az abban érintett gépekre kézzel telepítettem a megfelelő betűtípust rendszergazdaként.Egy újabb fejlesztés eredményeként egy excel fájlban szeretném alkalmazni az említett vonalkód-betűtípust, azonban mint előbb írtam ehhez rendszergazda jog szükséges.
A rendszergazda felhasználónév és jelszó ismert a számomra.A kérdés tehát az, hogy mezei felhasználóként bejelentkezve VBA-ból tudok-e -és ha igen, akkor hogyan- olyan másolás parancsot kiadni, ahol programból kerül megadásra a rendszergazda felhasználónév és jelszó felhasználói beavatkozás nélkül.
Azaz tudok-e a Font mappába másolni anélkül, hogy kérje a rendszergazda felhasználónevet és jelszót magától a felhasználótól?
a "FileCopy" parancsnál nem láttam olyan paramétert, hogy felhasználónév, jelszó.
Gondolkodtam még batch fájlban is hasonló megoldással ha esetleg abban meglehet oldani.Várom a javaslatokat! Köszi!
[ Szerkesztve ]
-
vilag
tag
Kis javítás a kódokban:
1. verzió:
Public szov As String
Public h As Long
Private Sub CommandButton1_Click()
vkod = ""
ossz = 0
szov = Trim(InputBox("Vonalkód értéke:", "Kód bevitel"))
ActiveSheet.Cells(3, 3) = szov
If szov = "" Then GoTo vege
h = Len(szov)
If h > 100 Then GoTo vege
Dim vk(2, 100)
For i = 0 To h
If i = 0 Then
vk(1, i) = Chr(204)
vk(2, i) = 104
Else
vk(1, i) = Mid(szov, i, 1)
vk(2, i) = Asc(vk(1, i)) - 32
End If
If i = 0 Then k = 1 Else k = i
ossz = ossz + vk(2, i) * k
vkod = vkod + vk(1, i)
Next
eossz = ossz Mod 103
ActiveSheet.Cells(2, 2) = eossz
If eossz < 95 Then
vkod = vkod + Chr(eossz + 32) + Chr(206)
Else
vkod = vkod + Chr(eossz + 100) + Chr(206)
End If
ActiveSheet.Cells(2, 3) = vkod
vege:
vege = MsgBox("Konverzió vége!", vbOKOnly, "Vége")
End SubValamiért nem csinálja meg a kiemelést.
Ez a javítás:
If eossz < 95 Then
vkod = vkod + Chr(eossz + 32) + Chr(206)
Else
vkod = vkod + Chr(eossz + 100) + Chr(206)
End If2. verzió:
Public szov As String
Public h As LongPrivate Sub CommandButton1_Click()
vkod = ""
ossz = 0
szov = Trim(InputBox("Vonalkód értéke:", "Kód bevitel"))
ActiveSheet.Cells(3, 3) = szov
If szov = "" Then GoTo vege
h = Len(szov)
If h > 100 Then GoTo vege
j = 1Dim vk(2, 100)
For i = 0 To h
Select Case i
Case 0
vk(1, i) = Chr(204)
vk(2, i) = 104
j = i
Case 1 To 2
vk(1, i) = Mid(szov, i, 1)
If Asc(vk(1, i)) < 195 Then vk(2, i) = Asc(vk(1, i)) - 32 Else vk(2, i) = Asc(vk(1, i)) - 100
j = i
Case 3
j = i
vk(1, i) = Chr(199)
vk(2, i) = Asc(vk(1, i)) - 100
Case Else
' If Application.WorksheetFunction.IsEven(i) = True Then 'XP alatt nem működik!!!
If i Mod 2 = 0 Then 'XP alatt is működik
j = i - ((i - 4) / 2)
s2 = Val(Mid(szov, i - 1, 2))
If s2 < 95 Then vk(1, j) = Chr(s2 + 32) Else vk(1, j) = Chr(s2 + 100)
vk(2, j) = s2
End IfEnd Select
If j = 0 Then k = 1 Else k = j
' If i <= 3 Or Application.WorksheetFunction.IsEven(i) = True Then 'XP alatt nem működik
If i Mod 2 = 0 Then 'XP alatt is működik
ossz = ossz + vk(2, j) * k
vkod = vkod + vk(1, j)
End If
Nexteossz = ossz Mod 103
ActiveSheet.Cells(2, 2) = eossz
If eossz < 95 Then
vkod = vkod + Chr(eossz + 32) + Chr(206)
Else
vkod = vkod + Chr(eossz + 100) + Chr(206)
End If
ActiveSheet.Cells(2, 3) = vkod
vege:
vege = MsgBox("Konverzió vége!", vbOKOnly, "Vége")End Sub
Remélem még hasznos lehet valakinek.
[ Szerkesztve ]
-
vilag
tag
Sziasztok!
Kicsit rég jártam erre...
/Szerencsére a program egy jó ideje viszonylag stabilan működik./
Most egy régi-új fejlesztési ötletet szeretnék végre befejezni, ami már félig készen van.
A lényeg az, hogy egy generált ügyiraton szeretnék vonalkódot megjeleníteni a korábban általam itt közzé tett algoritmussal.
Ez eddig meg is van.
A bibi ott van, hogy ehhez egy betűtípus telepítésére van szükség amit nyilván automatizálni szeretnék.
Részben azért, mert nem fogok mindig itt dolgozni (ez már biztos!), részben azért, mert a gépek fizikálisan is messze vannak, részben pedig azért, mert nem akarom egyesével minden gépen végrehajtani a telepítést.
A probléma az, hogy a betűtipus telepítése nem annyi, hogy a "Fonts" könyvtárba bemásolom azt.Kerestem a problémára megoldást és az alábbi kódot találtam:
Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String) As Integer
Declare Function CreateScalableFontResource% Lib "GDI" (ByVal fHidden%, ByVal lpszResourceFile$, ByVal lpszFontFile$, ByVal lpszCurrentPath$)
Declare Function AddFontResource Lib "GDI" (ByVal lpFilename As Any) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
' This sub installs a TrueType font and makes it available to all Windows apps. It takes these arguments:
'
' FontName$ is the font's name (e.g. "Goudy Old Style")
'
' FontFileName$ is the font's filename (e.g. "GOUDOS.TTF")
'
' WinSysDir$ is the user's System folder (e.g. "C:\WINDOWS\SYSTEM" or "C:\WINDOWS\SYSTEM32")
'
' ** Before calling this sub, your code must copy the font file to the user's Fonts folder. **
'
Sub ttf_install(FontName$, FontFileName$, WinSysDir$)
Dim Ret%, Res&, FontPath$, FontRes$
Const WM_FONTCHANGE = &H1D
Const HWND_BROADCAST = &HFFFF
FontPath$ = WinSysDir$ + "\" + FontFileName$
FontRes$ = Left$(FontPath$, Len(FontPath$) - 3) + "FOT"
Ret% = CreateScalableFontResource(0, FontRes$, FontFileName$, WinSysDir$)
Ret% = AddFontResource(FontRes$)
Res& = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
Ret% = WriteProfileString("fonts", FontName + " " & "(TrueType)", FontRes$)
End SubEzt kicsit módosítottam mert egyáltalán el sem indult, így a Sub sorból a zárójelben lévő részeket kivettem és az alatta lévő sorokkal egészítettem ki az alábbiak szerint:
Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String) As Integer
Declare Function CreateScalableFontResource% Lib "GDI" (ByVal fHidden%, ByVal lpszResourceFile$, ByVal lpszFontFile$, ByVal lpszCurrentPath$)
Declare Function AddFontResource Lib "GDI" (ByVal lpFilename As Any) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
' This sub installs a TrueType font and makes it available to all Windows apps. It takes these arguments:
' FontName$ is the font's name (e.g. "Goudy Old Style")
' FontFileName$ is the font's filename (e.g. "GOUDOS.TTF")
' WinSysDir$ is the user's System folder (e.g. "C:\WINDOWS\SYSTEM" or "C:\WINDOWS\SYSTEM32")
' ** Before calling this sub, your code must copy the font file to the user's Fonts folder. **
Sub ttf_install() '(FontName$, FontFileName$, WinSysDir$)
FontName$ = "Vonalkód"
FontFileName$ = "code128.ttf"
WinSysDir$ = Environ("WINDIR") & "\Fonts"
Dim Ret%, Res&, FontPath$, FontRes$
Const WM_FONTCHANGE = &H1D
Const HWND_BROADCAST = &HFFFF
FontPath$ = WinSysDir$ + "\" + FontFileName$
FontRes$ = Left$(FontPath$, Len(FontPath$) - 3) + "FOT"
Ret% = CreateScalableFontResource(0, FontRes$, FontFileName$, WinSysDir$)
Ret% = AddFontResource(FontRes$)
Res& = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
Ret% = WriteProfileString("fonts", FontName + " " & "(TrueType)", FontRes$)
End SubValamit azonban biztosan rosszul csinálok, mert nem tudom működésre bírni.
A megjegyzésben írtak szerint a betűtípus másolása megtörténik a Windows\Fonts mappába.
Nem tudom a megjegzésben mért a felhasználó Fonts mappát írja, mert olyan én nem találtam.
Esetleg itt a hiba, létre kéne hoznom egyet?
De sehol nem hivatkozik a felhasználói mappa Fonts könyvtárára...Az alábbi sornál azonban hibára futok:
Ret% = CreateScalableFontResource(0, FontRes$, FontFileName$, WinSysDir$)
A hiba:
Run-time error '53':
File not found.Van valakinek ötlete, hogyan tudnám ezt a dolgot működésre bírni?
[ Szerkesztve ]
-
vilag
tag
válasz sztanozs #2752 üzenetére
Először is köszönöm a választ!
Röviden: ebben a programban userformon töltött adatokból ügyirat generálható (természetesen különböző vizsgálatok, szabályok futkorásznak).
A lényeg az lenne, hogy a már korábban itt közzétett vonalkódos programrésszel elkészül egy vonalkód amit most már szeretnék rá is nyomtatni az ügyiratra. Eddig nem került rányomtatásra az ügyiratra.
Az ügyirat releváns adatai (a vonalkód által fedett számot is beleértve) egy ideiglenes fájlban tárolódik is.Ennek oka az, hogy az általam írt postakönyvbe, így a postázást végző kollegina a szám bepötyörészését követően a szükséges adatokat importálja a postakönyvbe, így neki nem kell még egyszer a szükséges adatokat felvinnie.
A vonalkód rányomtatása pedig azt a célt szolgálná, hogy a számsor begépelésétől is megkíméljem.A szépséghiba ugye ott van, hogy ehhez a szükséges betűtípusnak telepítve kell lennie azon a gépen amelyről az ügyirat nyomtatódik.
Mivel nem önálló program lenne, hanem a már meglévő programba kerülne beépítésre, mindenképpen Visual Basices megoldást keresek.
A rendszergazdai jogosultság elméletileg nem gond.
Először olyanban gondolkodtam, hogy csak vizsgálja meg, hogy jelen van-e a szükséges betűtípus és ha nem akkor adjon egy rövid figyelmeztetést és egy telepítési útmutatót, majd indítsa el a betűtípus fájlt, hogy a felhasználó telepíteni tudja, de sajnos ez sem vált be, mert nem volt hajlandó elindítani a fájlt.
Addig eljutottam, hogy followhyperlink-el meghívtam a fájlt, kaptam is gyári hibaüzenetet, hogy egyes fájlok megnyitása veszélyes lehet, de a fájl mégsem indult el.
Na meg persze sokkal elegánsabb (és biztosabb) lenne, ha mindez a felhasználó (tudta és) beavatkozása nélkül történne, tudjuk az hová vezethet...
Mindent figyelembe véve kérlek téged/titeket, hogy visual basic segítségével próbáljuk meg megoldani a problémát.
Egyszerűen nem értem, hogy mi lehet a probléma.
Bár ezeket nem értem:
Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String) As Integer
Declare Function CreateScalableFontResource% Lib "GDI" (ByVal fHidden%, ByVal lpszResourceFile$, ByVal lpszFontFile$, ByVal lpszCurrentPath$)
Declare Function AddFontResource Lib "GDI" (ByVal lpFileName As Any) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long(...)
FontRes$ = Left$(FontPath$, Len(FontPath$) - 3) + "FOT"
Ret% = CreateScalableFontResource(0, FontRes$, FontFileName$, WinSysDir$)Nem tudom mire jó az, hogy "ttf" kiterjesztés helyett "FOT" kiterjesztést ad (vagy virtuálisan ad) a fájlnak.
-
vilag
tag
válasz sztanozs #2754 üzenetére
Nagyon, nagyon szépen köszönöm!
Némi küzdés után teszi a dolgát ahogy kell (a küzdés persze az én hibámból volt).
Teszteltem egy-két gépen és amelyiken nem szükséges rendszergazda jog ott gyönyörűen teszi a dolgát.
Ahol azonban nincs telepítési jog ott:
XP esetén: látszólagosan nem történik semmi.
Win7 esetén: feljön az ablak, hogy adjam meg a rendszergazda felhasználónevét és jelszavát a telepítéshez.1. A kérdésem az lenne, hogy meg lehet-e valahogyan esetleg oldani, hogy a felhasználónév és jelszó megadása kódból történjen? (hátha a rendszergazda ideadja az adatait)
2. Le lehet-e kérdezni, hogy az adott felhasználó rendelkezik-e rendszergazdai (telepítési) joggal? A környezeti változókban (ENVIRON) nem találtam ilyet...
Utóbbira azért lenne szükség, hogy ha az első verzió valamilyen okból (esetleges jelszócsere pl.) nem működne. -
vilag
tag
Sziasztok!
Egy apró ám annál idegesítőbb problémával állok szemben ami inkább esztétikai jellegű mintsem funkcionális probléma.
Írtam én egy postakönyv programot, ami évek óta hűségesen szolgálja a hivatal működését idestova 7. éve.
A lényeg: a program gombnyomásra szűrést hajt végre a megadott paraméterek alapján, azaz legyűjti azokat a sorokat amelyek tartalmazzák a megadott karaktersort.
A probléma az, hogy az utolsó sorban az alsó rácsvonalak egy része (az első oszlopot kivéve) eltűnik és nem tudok rájönni miért.
Már próbáltam a kódba is beletenni a rácsozást, de nem vált be.
Marhára idegesítő probléma, van valakinek ötlete hol lehet a hiba? -
vilag
tag
válasz sztanozs #2760 üzenetére
Az az érdekes, hogy ha megnézed a képet, az első oszlopban jó az alsó border (mondjuk ott történik egy automatikus sorszámozás).
A probléma egyébként akkor keletkezett amikor Win Xp-s (Office 2003) gépekről Win7-es (Office 2007) gépekre tértünk át.
Egyébként kódból már próbáltam ezt megoldani:
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft) 'Bal
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop) 'Felső
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom) 'Alsó
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight) 'Jobb
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical) 'Belső függőleges
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End WithDe nem hozta a várt eredményt, szóval lehet még valahol valami turpisság a dologban.
-
vilag
tag
Újabb csoda:
Miért van az, hogy időnként úgy tűnik mintha az On Error funkció nem működne????
Jelesül:
On Error GoTo vege2
If Len(azonosito) = 8 Then
gazon = Right(azonosito, Len(azonosito) - 2)
elonev = Application.WorksheetFunction.VLookup(gazon, Workbooks(gtn).Worksheets("gtorzs").Range("c:aq"), 3, 0)
(...)Ha ott az On Error akkor miért kapom mégis ezt a hibaüzenetet:
Másik gépen ugyan ezt futtatva máshol akad ki, másik hibával, de ott is van On Error
Van valakinek ötlete, hogy mi okozza ezt az időnként előforduló hibát?
Esetleg ki tudom váltani az On Errort valamivel?Köszönöm!
-
vilag
tag
válasz Delila_1 #2767 üzenetére
Üdv!
Lehet, hogy nem volt egyértelmű amit írtam.
Ez a kód rész évek óta a helyén van és működik, azonban időnként (évente 3-4 alkalommal) gondol egyet és a fenti hibát produkálja.
Ilyenkor általában a gép újraindítása sem hoz megoldást.
Majd másnap ismét tökéletesen működik minden.A legutóbbi esetben amikor a hiba előjött, másik gépen is futtattam a kódot, ott meg egy másik kódrésznél akadt ki, de ott is on error volt hivatott megoldani a problémát.
Ezért gondoltam, hogy a környezetben lehet valami hiba, de nem tudom hogy mi. -
vilag
tag
Valaki mentsen meg az ablakon kiugrástól!!!!
Nem egészen VB kérdés, de hátha tud valaki valamit...
A szóban forgó munkafüzetben a képletek számításra manuálisra van állítva, mert a munkafüzet mérete több mint 20 Mb, és ha egyfolytában számolgatna amikor beleírok, akkor azzal telne az egész nap.
Kb. két napja előállt az a helyzet, hogy a munkafüzetben a képletek számítása továbbra is manuálison van, azonban mikor csinálok egy másolás beillesztést, akkor elkezdi újraszámolni a munkafüzetet.
Valaki mondja meg nekem legyen kedves, hogy ez most, hogy a bánatos fittyfenében lehet?
Más esetekben ugyan úgy nem számol, ahogy annak lennie kell, de másolás-beillesztésnél mégis számol.Hogy a ..csába tudnám ezt megakadályozni? Valami frissítés művelte ezt a csodát?
Az újraszámolás 4 maggal is igényben vesz 10-15 másodpercet. Nekem csak most legalább 70-100 ilyen kell végrehajtanom, ki lehet számolni, hogy akkor mennyi időt is fog igénybe venni mire végzek.
Van valakinek valami ötlete a probléma megoldását illetően??????
Szerk: Vélhetően az lehet a baj, hogy másik folyamatban ugyan csak megnyitottam a munkafüzetet olvasásra és az olvasásra nyitott táblából az írásra nyitott táblába történő másolás esetén csinálja ezt, bár így sem értem, hogy ehhez mi szükség újraszámolásra a forrástáblában.
[ Szerkesztve ]
-
vilag
tag
Sziasztok!
Az lenne a kérdésem, hogy lekérdezhető-e valahogyan az autofilterrel szűrt találatok eredménye?
A bal alsó sarokban ugye kiírja, hogy "4061 rekordból 13 rekordot talált"
Ez utóbbi számot szeretném valahogy VBA-ban lekérdezni.
Megoldható ez?
Googliban és VBA-ban sem találtam megoldást (ez persze nem azt jelenti, hogy nem is létezik megoldás).Üdv, vilag
-
vilag
tag
-
vilag
tag
Halihó!
Régen jártam erre, egy jó ideje nem volt időm VBA-val foglalkozni.
Most azonban szakítottam rá, de viszonylag hamar bele is futottam egy triviális bár számomra jelenleg megoldhatatlan problémába.
Állandóan bajban vagyok az excel és a VBA dátumkezelésével és ez újra és újra nehézségeket okoz.Most az alábbi problémával szembesültem:
Egy cellában dátumként tárolt dátumhoz tartozó másik dátumot szeretnék eredményül kapni egy dátumokat tartalmazó tömbből vlookup függvény segítségével.Eddig jutottam:
Private Sub CommandButton5_Click() 'adott sor jogerejének kiszámolása
aktivsor = ActiveCell.Row
aktivsor = Trim(Str(aktivsor))
If Range("m" + aktivsor) = "HIV" And Range("p" + aktivsor) = "" Then
uzenet = MsgBox("Nincs átvételi esemény, nem lehet jogerősíteni", 0, "Hiba") 'ideiglenes
Exit Sub
Else
If Range("q" + aktivsor) <> "nem kereste" And Range("q" + aktivsor) <> "elköltözött" And Range("q" + aktivsor) <> "címzett ismeretlen" Then
'dátum plusz 15 nap
atvdatuma = DateValue(Range("p" + aktivsor)) + 15
'atvdatuma = Trim(Str(atvdatuma))
'y = ThisWorkbook.Sheets("Jogerő").Range("a25")
x = Application.WorksheetFunction.VLookup(atvdatuma, ThisWorkbook.Sheets("Jogerő").Range("a:c"), 3, 0)
(...)Sajnos azonban az beillesztett utolsó sornál az alábbi hibaüzenetre futok:
Run-time error '1004':
Application-definied or object-definied errorMár minden általam ismert lehetséges módon próbáltam javítani, de nem sikerül.
Van valakinek ötlete mi lehet a hiba?
Előre is köszönöm!
-
vilag
tag
válasz Delila_1 #2933 üzenetére
Igen a jogerő lap A oszlopában vannak a dátumok amik között keresnie kellene.
A Trim(Str())-re azért volt szükség mert különben Run-time error '13': Type mismatch hibára futott.
Azonban most, hogy a + jeleket lecseréltem & jelre, úgy látom már semmi szükség rá, mert így enélkül sem fut a fenti hibára.
Még mindig kíváncsi lennék, hogy mi a különbség a + jel és az & jel között.
Gyakorlatilag egy sima fkeres függvényt akarok VBA-ban megcsinálni.
A fenti képen látható dátumok is dátumként formázott cellákban vannak.
-
vilag
tag
válasz Delila_1 #2935 üzenetére
Megcsináltam, végigléptettem, de ugyan az az eredmény mint korábban
Az utolsó sorban hibára fut.
Nem lehet, hogy az a baj, hogy amikor az atvdatuma változó felveszi az értéket az így néz ki:
atvdatuma = 2017.12.04.
Azaz idézőjelek nélkül és a nap után ponttal, a dátumos cellákban meg ugye idézőjelekkel és a nap után pont nélkül szerepelnek a dátumok.
Nem lehet, hogy ez okozza a problémát?
-
vilag
tag
válasz Delila_1 #2937 üzenetére
=FKERES(P7241;Jogerő!A:C;3;0)
#HIÁNYZIK hibára fut.
=FKERES(ÉRTÉK(P7241);Jogerő!A:C;3;0)
Így viszont eredményes.
Viszont ha a kódot kiegészítem ezzel:
atvdatuma = Val(atvdatuma)
akkor a atvdatuma = 2017,11 lesz, nem pedig dátumérték
Ebbe az irányba már próbáltam korábban elmenni, de ugyan ide lyukadtam ki.
Pedig szinte biztos vagyok benne, hogy ez lenne a megoldás kulcsa.[ Szerkesztve ]
-
vilag
tag
válasz Delila_1 #2939 üzenetére
x = Application.WorksheetFunction.VLookup(atvdatuma * 1, ThisWorkbook.Sheets("Jogerő").Range("a:c"), 3, 0)
Így működik
Utálom az excel dátumkezelését, és továbbra sem értem, hogy miért működik ha 1-el megszorzom.... de működik és most csak ez számít, remélem így már be tudom fejezni a kódot.
-
vilag
tag
válasz Delila_1 #2941 üzenetére
Pedig ha megnyitom a cellaformázás menüt akkor az van a "Szám" fülön, hogy "Dátum", típus: "*2001.03.14"
Ezért utálom én az excel dátumkezelését, mert gyakran még maga sem tudja, hogy mi micsoda.
Most pedig megpróbálom befejezni a kódot.
Még egyszer nagyon köszönöm!
Ma ismét tanultam valamit. -
vilag
tag
-
vilag
tag
Halihó!
Azt meg lehet valahogyan oldani, hogy ha kijelölök egy cellát akkor az adott sor háttere színt váltson?
Próbáltam a Workbook_Change()-ben megírni, de úgy tűnik, hogy a kijelölt cella változásakor a Workbook_Change () nem fut le.
Igazándiból nem is arra vagyok elsősorban kíváncsi, hogy mit írjak meg (bár erre is szívesen fogadok javaslatokat, hátha valakinek jobb ötlete van mint nekem), hanem sokkal inkább az, hogy hová kellene azt megírni.
Köszönöm!
[ Szerkesztve ]
-
vilag
tag
válasz Delila_1 #2953 üzenetére
Köszönöm a javaslatot.
Ma már kínlódtam vele vagy két óra hosszát, de belekavarodom a dologba és most teljesen máshogy akarom újra kezdeni.
Most épp látom a fényt az alagút végén, de csak pislákol.
A javaslatodat használva próbálkoztam, de nem teljesen hozza a várt eredményt.
Jelen formájában kiszínezi a kijelölt cellát vagy cellákat, azonban ha újabb cellát vagy cellákat jelölök ki akkor azokat is kiszínezi (az elősző színezések meghagyásával).A célom az lenne, hogy a kijelölt cellák sorait jelölje ki és az esetlegesen korábban kijelölt cella/cellák sorainak színezését pedig szüntesse meg.
A fejemben már össze is állta a dolog el is kezdtem megírni, de ott elakadtam, hogy több sort érintő kijelölés esetén csak az első sor sorának a számát tudom lekérdezni pl ezzel
sorok = Selection.Row
pedig nekem a kijelölés kezdő és végsorának számára is szükségem lenne.Próbáltam
Selection.Address
kóddal is de abból meg csak kerülő úton tudnám a sorok számát kinyerni.Van esetleg erre valami egyszerűbb megoldás?
Egyébként nagyjából így képzelném a kódot:
Cells.Interior.Pattern = xlNone 'összes színezés megszüntetése a munkalapon
kijelolttartomanysorai = ????
Rows(kijelolttartomanysorai).Interior.Color = vbYellowÍgy visszanézve kissé viccel, hogy egy 3 soros kóddal bajlódom két órája
-
vilag
tag
válasz Delila_1 #2955 üzenetére
Ez eddig rendben van, ezt én is megoldottam (ugyan ennél kevésbé elegánsabban), de egy fontos körülmény elkerülte a figyelmedet:
Én nem magát a kijelölt területet akarom átszínezni, hanem a kijelölt területtel érintett egész sorokat.
Az egésznek a lényege az lenne, hogy amolyan sorvezetőként szolgálna a szemnek.
De lehet, hogy az általad írt kódból is meg tudom oldani a dolgot, mert most kipattant egy ötlet a fejemből, meglátjuk működik-e.
[ Szerkesztve ]
-
vilag
tag
válasz Delila_1 #2957 üzenetére
A
Target.Row
-t már próbáltam, de az csak a kijelölt tartomány első sorának sorszámát adja vissza lekérdezésben.A
Rows(Target.Row).Interior.Color = vbYellow
pedig ugyan megtartja az eredeti kijelölést, de csak a kijelölt tartomány első sorát színezi át.Tehát még mindig az a probléma, hogy hogyan lehetne lekérdezni a kijelölt tartománnyal érintett sorokat?
A
x=Targer.Address
visszaadja a teljes tartományt, de abból meg ki kellene mókázni a sorok számát...Ezért valami ettől egyszerűbb megoldást keresek.
-
vilag
tag
válasz Delila_1 #2959 üzenetére
Nagyon szépen köszönöm!
Kicsit egyszerűsítettem rajta mivel biztosan nem lehet a munkalapon semmi korábbi színezés, így annyit csináltam, hogy minden színezést töröl és utána színezi az érintett sorokat a módszered szerint.
Egyébként azt furcsállom, hogy a
Target.Rows
nem működik.
Pedig a Target-nek van Row és Rows tulajdonsága is, legalábbi a "." billentyű után felkínálja mint lehetőséget. -
vilag
tag
válasz Delila_1 #2969 üzenetére
Ez a megoldás tényleg sokkal frappánsabb.
Apróbb kiegészítésekkel (ami nem képezte részét az eredeti koncepciónak) be is építettem.Néhány kivételkezelést tettem még hozzá, de ezek mind szépészeti beavatkozások. PL.: hogy csak olyan tartományt jelöljön ki ahol már van érték, meg a fejléces tartományban ne jelöljön ki, ilyesmi...
Köszönöm a segítséget!
-
vilag
tag
Üdv!
Le lehet valahogyan kérdezni, hogy az adott munkalap hány nyomtatás szerinti oldalból áll?
Wordben le tudom, de excelben egyelőre nem találom.
Wordben:oldalszam = ActiveSheet.BuiltinDocumentProperties(wdPropertyPages)
-
vilag
tag
válasz Delila_1 #2973 üzenetére
Tökéletes!
Remekül sikerült megoldani a problémát.
Felvetnék még egy kérdést amelyre régóta nem lelem a megoldást.
Van egy olyan TextBoxom (illetve több is), amely úgy van megoldva, hogy csak számokat enged bevinni az alábbi kóddal:Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Ügyirat főszámba csak számot enged írni
If KeyCode = 8 Or KeyCode = 46 Or _
(KeyCode >= 48 And KeyCode <= 57) _
Or (KeyCode >= 96 And KeyCode <= 105) Then
TextBox1.Locked = False
Else
TextBox1.Locked = True
End If
End SubValamilyen okból ha a munkafüzetet Office 2007-ben Win7-es gépen mentem el, random módon az a jelenség következik be, hogy elindítva a formot a mezőbe nem csak számot enged írni, valamint ha nyomok egy TAB-ot akkor nem a következő vezérlőre ugrik hanem valóban egy tabulátort tesz az adott vezérlőbe.
Ez ugye hibás működést eredményez és számos problémát okoz.
Arra viszont rájöttem, hogy ha egy Win Xp-s gépen (és azt hiszem Office 2003-on) makrók letiltásával indítom a munkafüzetet és rámentek, akkor már a Win7-es Office 2007-es gépeken sem jelentkezik a probléma.
Van esetleg ötleted (vagy bárkinek), hogy mivel lehetne ezt kiküszöbölni.
Most csak ezért megint össze kellett raknom egy Xp-s gépet amit gyakorlatilag csak ennyire használok.Egy másik apró de idegesítő probléma:
A munkafüzet indításakor automatikusan indul a form. Ezen van egy gomb amely lehetővé teszi a VB indítását és ezzel együtt a jelszavazás feloldását is az alábbi módon:Unload Me
Unload UserForm1
Application.Visible = True 'hogy az Excel menüje újra látszódjon
'Project védelem feloldása
With Application
.SendKeys "%{F11}", True 'VB megnyitása
.SendKeys "^r", True 'Project Explorer ablak aktiválása
.SendKeys "SZTK" 'SZTK projectre ugrás
.SendKeys "~", True 'Enter leütés imitálása
.Wait (Now + TimeValue("0:00:01"))
.SendKeys "jelszó" 'Jelszó megadása
.SendKeys "~", True 'Enter leütés imitálása
' .Wait (Now + TimeValue("0:00:01"))
' .SendKeys "Mod"
' .SendKeys "~", True 'Enter leütés imitálása
' .Wait (Now + TimeValue("0:00:01"))
.SendKeys "For"
.SendKeys "~", True 'Enter leütés imitálása
' .Wait (Now + TimeValue("0:00:01"))
' .SendKeys "Mic"
' .SendKeys "~", True 'Enter leütés imitálása
End WithA folyamat végén valóban indul a VB, de valamiért a NUMLOCK-ot kikapcsolja.
Ugyan ez a fentebb említett Xp-s gépen is lefut azonban ott nem kapcsolja ki a NUMLOCK-ot.A kívánatos az utóbbi lenne.
-
vilag
tag
Valakinek van ötlete hivatkozott problémával kapcsolatban?
+1 kérdés:
Adott egy munkafüzet aminek az egyik lapját (vagy annak tartalmát) másolom egy új munkafüzetbe és mentetem el kód segítségével.
Szerencsére a munkalapon lévő gomb (és a hozzá tartozó kód is) megye vele.Meg lehet-e valahogyan oldani, hogy az újonnan létrejövő munkafüzet "ThisWorkbook"-jába kódot helyezzek el?
Oda szeretném megírni, hogy bezárás előtt ne dobjon fel hibaüzenetet, hanem mindent figyelmen kívül hagyva zárja be.
Nevezetesen:Application.Displayalerts = False
A gombnyomásra lefutó makró miatt ugyan is bezárás előtt megkérdezi, hogy akarok-e menteni.
Ezt viszont nem szeretném, mert a felhasználók amúgy sem tudnak beleírni a munkafüzetbe, így semmi szükség erre, csak összezavarja szegényeket...Sajnos ebben a formában eredménytelen:
Private Sub CommandButton1_Click()
ActiveSheet.PrintOut Copies:=2, Collate:=True
Application.DisplayAlerts = False
End Sub[ Szerkesztve ]
-
vilag
tag
Sziasztok!
Lenne egy fontos és sürgős kérdésem:
Tudok-e VBA-ban "öngyilkos kódot" írni?
A lényege az lenne, hogy ha valaki a Projektet védő kódot mondjuk 3-szor rosszul üti be (VBAProject - Project Properties/Protection), akkor az azt eredményezi, hogy a projektből az összes kód törlődik és ráment a munkafüzetre.
Úgy néz ki elhagyom a jelenlegi munkahelyemet és a programokat ugyan itt hagyom, használhatják, de nem akarom, hogy a kódhoz bárki is hozzábabráljon (mégis csak az én "gyermekem").
Továbbá érdekelne, hogy hogyan is kell levédetni jogilag egy programot.
Mivel már csak korlátozottan fogok hozzáférni a gépemhez, nagyon sürgős lenne a dolog.
Köszönöm!
-
vilag
tag
válasz Apollo17hu #2998 üzenetére
Köszönöm!
Meg fogom tenni.
-
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?
[ Szerkesztve ]
-
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!
[ Szerkesztve ]
Új hozzászólás Aktív témák
- Óra topik
- Hamarosan megjön a Samsung 360 Hz-es QD-OLED monitora
- Hisense LCD és LED TV-k
- Samsung Galaxy Tab S6 Lite 2024 - a visszatérő
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Autós kamerák
- BMW topik
- Formula-1
- AMD GPU-k jövője - amit tudni vélünk
- Mibe tegyem a megtakarításaimat?
- További aktív témák...
- Modolt Magyar ASUS ROG Strix Scope II 96 Wireless keresi gazdáját
- Eladó Legamaster Airserver Connect 2 - 2 darab!
- MacSzerez.com - iPhone 11 / 128GB / Kártyafüggetlen / Zöld / Új akkumulátor! / Garancia!
- Laptophoz keresek 8GB-os DDR4-es modulokat több darabot
- Msi GeForce RTX 3080 Gaming Z Trio 12 Gb (Foxpost az árban)
- Silverstone GD06B (Vadi új fényezéssel) MINT AZ ÚJ!
- Thinkcentre M70a AIO PC GEN 3 21.5" FHD IPS Touch Core i5 12600 16GB RAM 512GB NVME SSD 1TB HDD Gar
- Asus NVIDIA Strix GTX 1660 Super 6GB
- Dell Latitude 7430 2 in 1 14" FHD Touch Core i7 1265U 16GB RAM 512GB SSD HUN Bill GAR
- linksys befsr41 10/100 lan router firewall 4port Cisco E900 router 300mbps wireless firewall 4port
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: Ozeki Kft.
Város: Debrecen