- Nagyon gyorsan betilthatja az EU a TikTok újítását
- Bittorrent topik
- Hálózati / IP kamera
- Vodafone otthoni szolgáltatások (TV, internet, telefon)
- Xiaomi AX3600 WiFi 6 AIoT Router
- Olcsóbb lett a Tesla Full Self-Driving szoftvere
- Windows 10
- SkyShowtime
- Direct One (műholdas és online TV)
- Sorra osztja a dollármilliárdokat az USA a chipgyártóknak
Új hozzászólás Aktív témák
-
bepken
veterán
válasz martonx #2401 üzenetére
próbáltam kicsit egyszerűsíteni - saját magamnak - mivel ez az első vb program, amivel próbálkoznék
más kezéből egem is irritál az ilyen "felemás" munka, úgyhogy átérzem az ellenszenvedetvalami ötlet esetleg a kérdésemre?
╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
martonx
veterán
-
bepken
veterán
akkor ismét lenne pár kérdésem:
- hogy lehet azt megoldani, hogy a TextBox-ba beírt szövegre az enter billentyűt lenyomva is rá tudjak keresni? gondolom a TextBox-hoz kell hozzárendelni ezt:
Private Sub txtFind_Enter(ByVal sender As Object, ByVal e As System.EventArgs) Handles txtFind.Enter
End Subvalahogy így kell nekikezdeni? ha ide beírom ugyanazt a feltételt, amit a "Keres" gombnál működik, akkor sem akar összejönni valamiért...
- a másik kérdésem pedig az volna, hogyan tudnám megoldani azt, hogy egy a vágólapra felvett számot adott formátumra "átalakítsa"?
tehát mondjuk egy telefonszám esetében törölje a felesleges szóközöket vagy "/ - +" karaktereket╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
bepken
veterán
rendben, az egyik kipiálva:
a Form1 tulajdonságainál >>"KeyPreview = True"
majd:
Private Sub Form1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress
If Asc(e.KeyChar) = 13 Then
Me.dataBindingSource.Filter = "[number] = '" & Me.txtFind.Text & " ' "
End Ifa másik kérdésemre viszont egyelőre nem találtam megoldást...
╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
sztanozs
veterán
Az Enter esemény az nem az, amikor entert nyomsz.
Azt így tudod megccsinálni, ahogy írtad. Esetleg még Validate-tel - de ott ha be van állítva, hogy validate on focus lost (vagy valami hasonló), akkor akkor is lefut a validate, ha kikantitasz a mezőből (vagy Tab-bal tovább mész).JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...
-
vilag
tag
Office 2003-hoz tarozó VBA-ban használtam az "Application.FileSearch" funkciót, azonban az Office 2007-hez tartozó VBA-ban ilyen már nincs.
Tudja esetleg valaki, hogy mi van helyette, mert eddig én nem találtam meg.
Előre is köszönöm!
-
vilag
tag
Csak egy bajom van, az, hogy a Refereciákhoz hozzá kell adni a következőt:
Microsoft Scripting RuntimeMeg lehet valahogy oldani, hogy ez a hozzáadás programkódból történjen?
Sajnos a makrórögzítés semmit nem vett fel.
Fontos lenne, hogy ezt le tudjam vezérelni, mert a programot mások is használják, és hát nem hiszem, hogy mindenki el tudja végezni ezt a műveletet. -
bepken
veterán
azt hiszem, a telefonszám "konvertálást" is sikerült megoldani, bár a gyakorlatban még csak pár példával próbálkoztam:
Private Sub btnFind_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFind.Click
txtFind.Paste()
txtFind.Text = Replace(txtFind.Text, " ", "")
txtFind.Text = Replace(txtFind.Text, "/", "")
txtFind.Text = Replace(txtFind.Text, "(", "")
txtFind.Text = Replace(txtFind.Text, ")", "")
txtFind.Text = Replace(txtFind.Text, "-", "")
txtFind.Text = Replace(txtFind.Text, "+", "")
If txtFind.TextLength > 7 Then
If txtFind.Text.StartsWith("06") Then
txtFind.Text = txtFind.Text.Substring(2)
End If
If txtFind.Text.StartsWith("36") Then
txtFind.Text = txtFind.Text.Substring(2)
End If
End If
TelBindingSource.Filter = "[tel] = '" & Me.txtFind.Text & " ' "
End Subígy elviekben a vágólapra vett (legtöbbször keszekusza formátumú) számokat szépen "letisztítja" és ezután keres az adatbázisban
mennyire elegáns ez így szerintetek?
illetve arra nem jöttem még rá, hogyan lehetne megoldani, hogy a TextBox-ban található értéket minden alkalommal alapból felülírja.
nem hozott megoldást az sem, ha beállítottam, hogy 7 karakter hosszú legyen a TextBox, mert ekkor alapból az első 7 karaktert kezdte vizsgálni, ami meg ugye esetemben nem igazán előnyös...[ Szerkesztve ]
╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
bepken
veterán
válasz martonx #2412 üzenetére
köszi! utánaolvasok majd, hogyan kell használni - mert gyorsan rákeresve nem igazán fogtam fel a lényegét
igazából még két dolgot kellene megoldanom a teljes lelki-béke eléréséhez:
1. az fent említett karakter felülírást (ezt szerintem meg fogom találni guglival)
2. ha a keresett érték szerepel a csatolt adatbázisban, azt jelezze. - találtam olyan kódot, amivel elértem, hogy msgbox-ként felugorjon a "hibaüzenet", de nekem label-be lenne ideális (ne kelljen feleslegesen ok gombra kattintgatni)...és valamiért ez nem akar összejönni.╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
cigam
félisten
Csináltam egy stoppert. Azt szeretném, hogy billentyűzettel is lehessen vezérelni, de nem tudom hogyan. Amit találtam példakódot nem működik:
Public Class Form1
Dim perc As String = "00"
Dim masodperc As String = "00"
Dim idoszoveg As String = "00:00"
Private Sub ido_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles ido.KeyDown
If e.KeyCode = Keys.F1 Then Timer1.Start()
End Sub
Private Sub startgomb_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles startgomb.Click
Timer1.Start()
End Sub
Private Sub stopgomb_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles stopgomb.Click
Timer1.Stop()
End Sub
Private Sub resetgomb_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles resetgomb.Click
perc = "00"
masodperc = "00"
idoszoveg = "00:00"
ido.Text = idoszoveg
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
masodperc += 1
If masodperc = "60" Then
masodperc = "0"
perc += 1
If perc < 10 Then perc = "0" & perc
End If
If masodperc < 10 Then masodperc = "0" & masodperc
idoszoveg = perc & ":" & masodperc
If perc = "100" Then
perc = "00"
masodperc = "00"
idoszoveg = "00:00"
End If
ido.Text = idoszoveg
End Sub
End Class[ Szerkesztve ]
Freeware, és akciós programok egy helyen https://www.facebook.com/freewarenews
-
bepken
veterán
sziasztok!
a következő problémám volna:
teljesen elölről kezdtem a kis művemet, ezúttal külső adatbázisra hivatkozik és ez kellően meg is bonyolította számomra a dolgokat...így néz ki a kereső gomb click event:
Private Sub btnFind_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFind.Click
'telefonszám szövegének formázása
txtTelNumber.Text = ""
txtTelNumber.Paste()
txtTelNumber.Text = Replace(txtTelNumber.Text, " ", "")
txtTelNumber.Text = Replace(txtTelNumber.Text, "/", "")
txtTelNumber.Text = Replace(txtTelNumber.Text, "(", "")
txtTelNumber.Text = Replace(txtTelNumber.Text, ")", "")
txtTelNumber.Text = Replace(txtTelNumber.Text, "-", "")
txtTelNumber.Text = Replace(txtTelNumber.Text, "+", "")
If txtTelNumber.TextLength > 7 Then
If txtTelNumber.Text.StartsWith("06") Then
txtTelNumber.Text = txtTelNumber.Text.Substring(2)
End If
If txtTelNumber.Text.StartsWith("36") Then
txtTelNumber.Text = txtTelNumber.Text.Substring(2)
End If
End If
con.Open()
sql = "SELECT [tel] from tel"
da.Fill(ds, "tel")
con.Close()
For index = 0 To ds.Tables("tel").Rows.Count - 1
Dim dt As DataTable
dt = ds.Tables("tel")
If txtTelNumber.Text = ds.Tables("tel").Rows(index).Item("tel") Then
lbTelNum.Text = ds.Tables("tel").Rows(index).Item("tel")
Else
lbTelNum.Text = ""
End If
If lbTelNum.Text = "" Then
lbTelNum.Text = ""
lbExist.Text = ""
Else
Me.lbTelNum.Text = Me.lbTelNum.Text
Me.lbExist.Text = "Már létezik!"
End If
Next
End Suba cél továbbra is az volna, hogy a textbox-ba beírt számot keresse meg az access táblában, majd ha megtalálja, azt jelezze.
ez ugye most úgy néz ki, hogy ha a "txtTelNumber" mezőbe beírt szám benne van a táblában, annak értéke kerüljön át az "lbTelNum" mezőbe (és mellette az "lbExist" is írjon ki valamit) >> hogyha a "lbTelNum" üres, akkor egyszerűen nullázza ki ezt a két mezőt.
a gyakorlatban ez működik is, de csak az első érték beadásakor....ha jól sejtem, az lehet a gond, hogy a következő kattintáskor már nem fut le a ciklus.
próbáltam Else ágon újra beadni neki ugyanezt a ciklust, de csúnyán megakasztottam vele a gépet, úgyhogy valószínűnek tartom, hogy nem az lesz a megoldás...várom az ötleteket, véleményeket!
_____________________________________________________
szerk.:
cigam!a Form_Load részhez írd be:
KeyPreview = True[ Szerkesztve ]
╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
cigam
félisten
a Form_Load részhez?
1 hete ismerkedem a VB2010expressel, semmi nem evidencia.Viszont most megint átnéztem jobboldalt a properties ablakban a "Form1 System.Windows.Forms.Form" listájában a "KeyDown"-hoz tudtam társítani az "ido_KeyDown" szubrutint, és most működik!
- A form load részt hol találom, és a program "melyik része" ez?
- Ez a "Form1 System.Windows.Forms.Form" micsuda?Freeware, és akciós programok egy helyen https://www.facebook.com/freewarenews
-
bepken
veterán
ja hát én meg ~2 hete, szóval túl sokat én sem tudok segíteni, csak abban, amilyen problémával én is találkoztam eddig
nálam a billentyű figyelés így néz ki:
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
KeyPreview = True
....tehát (az én olvasatomban legalábbis), ha az adott form aktív, akkor figyeli a leütött billentyűket
illetve van egy "KeyPress" event is:
Private Sub Form1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles Me.KeyPress
If Asc(e.KeyChar) = 13 Then
....ez meg az Enter billentyűt várja (ASCII kód: 13)
egyébként engem kifejezetten zavar, hogy sok dolgot a properties résznél és magában a kódban is meg lehet adni...pontosabban az, hogy a properties résznél már beállított értékek nem derülnek ki a kódból. vagy ezzel csak én vagyok így?
╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
cigam
félisten
Nem, ez engem is zavar tegnap óta
Vissza akarom kapni a régi jó BASIC nyelvet "visual" nélkül. Eszméletlen miket csináltunk anno a a 8bites otthoni gépekkell...
martonx
Nem valószínű, hogy továbblépek. Az otthoni apróságok, és kissebb céges, a munkámat megkönnyítő programocskákat faragok a magam szórakoztatására. Ez a stopper sem több mint 20-30 sor, mégis elvarázsol mire (vagyok) képes.
A továbblépés azért is kétséges, mert pénzt nem adok értük, és nem is keresek velük. Szórakozásnak meg pöttyet drágák, és tényleg nem használnám ki. Jelenleg elég távolinak tűnik, hogy az VBexpress korlátaiba ütközzek. Bár kíváncsi vagyok, hogy egy WindowsPhone program, (pl. ez a stopper) mennyivel bonyolultabb.Freeware, és akciós programok egy helyen https://www.facebook.com/freewarenews
-
martonx
veterán
"egyébként engem kifejezetten zavar, hogy sok dolgot a properties résznél és magában a kódban is meg lehet adni...pontosabban az, hogy a properties résznél már beállított értékek nem derülnek ki a kódból. vagy ezzel csak én vagyok így?"
Ez szvsz előny. Jellemzően sokkal jobban szeretek varázslóval kattintgatni (pár linux-os konzol buzin kívül az emberiség 99,99%-a ugyanígy van ezzel). Ugyanakkor csomó olyan eset létezik, amikor muszáj kódból lekezelned a dinamikusan létrehozott formjaidat, ekkor nagy előny, hogy kétféle megközelítéssel is dolgozhatsz.
A kódból pedig minden kiderül, ugyanis lekérdezhető.Én kérek elnézést!
-
martonx
veterán
"Vissza akarom kapni a régi jó BASIC nyelvet "visual" nélkül. Eszméletlen miket csináltunk anno a a 8bites otthoni gépekkell..."
Hál'istennek azért a világ néha fejlődik is, gyakran csak nagy köröket fut a fejlődés, de azért egy vb.net-et összehasonlítva egy C64-es BASIC-el a fejlődés igen szembeötlő.
"A továbblépés azért is kétséges, mert pénzt nem adok értük, és nem is keresek velük. Szórakozásnak meg pöttyet drágák, és tényleg nem használnám ki."
Oké, nekem tök mindegy miben programozol, ízlések és pofonok. Viszont legalább ne írj butaságot, hogy azért nem akarsz továbblépni, mert drágák, és nem adsz értük pénzt. Mi a drága egy ingyenes wpf-en? És egy ingyenes ASP.NET-en?
Szóval használj nyugodtan winforms, simán elég lehet sok mindenre. De legalább ne beszélj butaságot.Én kérek elnézést!
-
cigam
félisten
Hogyan tudnám optimalizálni a dolgot, hogy pl. a reset-et ne keljen újra lekódolni?
...
If e.KeyCode = Keys.F3 Then
perc = "00"
masodperc = "00"
idoszoveg = "00:00"
ido.Text = idoszoveg
End if
....
Private Sub resetgomb_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles resetgomb.Click
perc = "00"
masodperc = "00"
idoszoveg = "00:00"
ido.Text = idoszoveg
End SunVagyis milyen parancsal tudom meghívni a "resetgomb_Clik" rutint?
If e.KeyCode = Keys.F3 Then resetgomb_Click()?[ Szerkesztve ]
Freeware, és akciós programok egy helyen https://www.facebook.com/freewarenews
-
bepken
veterán
válasz martonx #2425 üzenetére
igazad van sőt! igazából, amikor belefogtam ebbe a kis programba, még azt hittem, ennyit se kell majd a kóddal foglalkoznom...
egy verziót már sikerült megcsinálnom a varázsló segítségével - tehát csak importáltam a táblát, betettem azt az egy szövegdobozt, majd megadtam neki a forrást. szóval valóban sokkal kényelmesebb volt na.
[ Szerkesztve ]
╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
óbébai
újonc
Sziasztok!
Hogyan kell munkafüzetet (excel) váltani makróval. Lehetne-e egy cellában megjelenő munkafüzet nevet használni?
Az a probléma, hogy több munkafüzethez is használni kellene, de mindegyiknek más a neve, csak az a munkafüzet azonos, ahonnan indítanám a makrót.
Arra gondoltam, hogy egy legördülő listából kiválasztom azt a munkafüzetet amelyikre váltani kellene.
Mielőtt valaki szóvá tenné, hogy ennek mi az értelme? Csak annyi, hogy így lehetne egy ciklussal átpakolni adatokat.
Üdv -
sztanozs
veterán
Nem kell megjeleníteni a munkafüzetet amibe vagy amiből át akarod rakni az adatokat.
Az összes munkafüzetet megtalálod az Application.Workbooks collection-ben, és a kiválaszott workbook adott worksheet-jéről tudsz másolni egy másik wokbook másik worksheet-jére.JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...
-
bepken
veterán
írtátok korábban, hogy a VB már nem igazán érdemli meg, hogy jobban beleássa magát az ember...
tehát az volna a kérdésem, hogy melyik az az alternatíva, amivel a VB-hez hasonlóan egyszerűbb programokat lehetne tervezni?╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
martonx
veterán
félreértés, nem a VB-vel van gond, hanem a winforms-sal.
Pontosabban gond ezzel sincs, csak már lassan 10 éve legacy állapotban létezik. És persze lész még 10 év múlva is, de minek most elkezdeni bárkinek is beleásni magát egy legacy technológiába?Amit javaslok helyette a WPF (legújabban windows store), de amit leginkább javaslok az az ASP.NET (MVC). Ezeket mind lehet VB-vel is használni, bár időközben a VB helyett erősen a C# terjedt el, ne lepődje meg, ha a tutorialok 80%-át csak C#-ban fogod találni.
Én kérek elnézést!
-
bepken
veterán
válasz martonx #2433 üzenetére
köszi!
suli kapcsán úgy is muszáj C-vel foglalkozzak...szóval lehet, hogy amúgy sem árt meg, ha inkább a C#-ba merülök el jobban.
persze azzal is tisztában vagyok, hogy ehhez még rengeteg alapozásra van szükség, csak az irányra voltam kíváncsi.
╔═══════ "Csak egy visszatérés létezik és az nem a királyé...hanem a JEDIÉ!" ═════╗ ╚════════════════ Xiaomi Mi A1 ═════ Huawei Nova 5T ═════════════╝
-
G.I.JOE
senior tag
Helló!
Csak ismerkedek a VB-el és szeretnék egy egyszerű progit írni, ami excelből egy tabulátoros unicode txt-t csinál. Nos, az unicode-dal is van gondom (OpenTextFileWriter), de a fő bajom az, hogy ha VStudioból indítom a progit, akkor lefut rendesen, de ha a generált exe-t indítom el és eljut az excel műveletekig, akkor az "Nincs elég szabad memória ..." hibaüzenettel leáll.
Valami banális dolgot nem tudok?
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim munkakonyvtar As String = "c:\" 'itt a forras excel es ide generalja az eredmenyfilet
Dim file = My.Computer.FileSystem.OpenTextFileWriter(munkakonyvtar + "test.txt", False) 'kimeneti file
Dim munkalap As String = "Munka1" 'a használandó munkalap neve az excelben
Dim sor As Integer = 6 'aktualis excel cella sorszama, kezdoertek az elso adat sor száma
Dim oszlop As Integer = 2 'aktualis excel cella oszlop
Dim cella As String = "" 'aktualis excel cella tartalma
Dim MH_sor As String = "" 'aktualis sor a kimeneti fileba
xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Open(munkakonyvtar + "test1.xlsx")
xlWorkSheet = xlWorkBook.Worksheets(munkalap)
cella = xlWorkSheet.Cells(sor, 1).value
Do While Len(Trim(cella)) > 0
MH_sor = xlWorkSheet.Cells(sor, 2).value + Chr(9) + xlWorkSheet.Cells(sor, 3).value + Chr(9) + xlWorkSheet.Cells(sor, 4).value
file.WriteLine(MH_sor)
sor = sor + 1
cella = xlWorkSheet.Cells(sor, 1).value
Loop
MsgBox("Kész!")
xlWorkBook.Save()
xlWorkBook.Close()
xlApp.Quit()
file.Close()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet) -
martonx
veterán
válasz G.I.JOE #2435 üzenetére
Ez így nem tűnik rossznak első ránézésre.
A "Nincs elég szabad memória", nem lehet hogy azt jelenti, hogy tényleg nincs? Ugyanazon a gépen futtatod VS-ből, mint az exe-t?
Ha valami hiba történik a kódban mivel nem using-ot használsz, és nincs semmi hibakezelés benne, simán nyitva tudnak maradni az excelek. Egy idő után akár 20-30 párhuzamosan futó exceled is lehet.Én kérek elnézést!
-
FranZi
csendes tag
Sziasztok,
keresek First Imnpression Chart 32-bites OCX-et, vagy telepítőt, vcfi32.ocx
és
Apex True DBGrid-et, tdbg32.ocx-et, illetve telepítőt. Kő régi holmi, de most módosítanom kellene egy régi programot, ami Visual Basic 5.0-ban íródott.Millió hála előre is...
-
új kérdező
csendes tag
Tisztelt Mindenki!
Ezúton szeretnék segítséget kérni. autocad 2010-ben írtam egy makrót (VB6) Ami annyit tesz, hogy egy excel táblából átvesz egy cella értéket és megnyitja a hozzá tartozó fájlt és beilleszti a másik oszlopban lévő szöveget blokként, itt jön egy modalis Userform amiben a felhasználó szétrobbantja a beillesztett blokkot. A userformot szerettem volna egy olyannal kiváltani, hogy egy adott billentyűre történjen meg a szétrobbantás de úgy hogy a megnyomás előtt a felhasználó a beillesztett blokkot tudja forgatni meg stb. De mivel ezt nem tudom ezért lett a modális Userform, mivel nagyon- nagyon gyenge vagyok a témában.
De igazából nem ezt a fő gondom.Erre a feladatra szeretnék egy ciklust kérni, azaz, hogy az exceltáblában menjen végig a sorokon amíg el nem fogynak az adatok, de úgy, hogy várja meg amíg a Userformon lévő művelet is lezajlik.
Sub Example_StartAngle()
Dim xlApp As Object
Dim xlBook As Object
Dim xlBooks As Object
Dim xlSheets As Object
Dim xlSheet As Object
Dim xlCells As Object
Dim xlRange As Object
Dim futott As Boolean
futott = True
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then
futott = False
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "nem sikerült elindítani az exel-et"
End If
End If
' AutoCAD alkalmazás ablak megjelenítése
xlApp.Application.Visible = True
Set xlBooks = xlApp.Workbooks
If xlBooks.Count > 0 Then
Set xlBook = xlBooks.Item(1)
End If
If xlBooks.Count = 0 Then
Set xlBook = xlBooks.Open("C:\Users\ko\Documents\számbeíráshoz.xlsx")
End If
Set xlSheets = xlBook.worksheets
Set xlSheet = xlSheets.Item(sheetName) '<--- change a sheet name (might be a sheet number instead)
xlSheet.Application.Visible = True
Set xlCells = xlSheet.Cells
Set xlRange = xlCells.Range("$A1")
Dim AcadApp As AcadApplication
Dim MyDxf As AcadDocument
Set AcadApp = GetObject(, "AutoCAD.Application")
Dim fnev As String
fnev = Cells(s, 1)
If fnev = "" Then
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing
MsgBox "vége"
Exit Sub
End If
Set MyDxf = AcadApp.Documents.Open("l:\sw2010rajz\dxf-k szöveghez\" & fnev & ".dxf")
ZoomExtents
Dim newLayer As AcadLayer
' Create a Layer and make it the active layer
Set newLayer = ThisDrawing.Layers.Add("gravir")
newLayer.Color = acRed
ThisDrawing.ActiveLayer = newLayer
ThisDrawing.Regen (True)
Dim textObj As AcadText
Dim textString As String
Dim insertionPoint As Variant
Dim height As Double
textString = Cells(s, 2)
insertionPoint = ThisDrawing.Utility.GetPoint(, "Kattints a beillesztési ponthoz: ")
height = 5
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
ZoomExtents
Dim exportFile As String
exportFile = "c:\wmf-k\" & fnev & ""
Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("NEWSS")
sset.Select acSelectionSetLast
'sset.Select acSelectionSetAll
' Export the current drawing to the file specified above.
ThisDrawing.Export exportFile, "WMF", sset
textObj.Delete
Dim blockRefObj As AcadBlockReference
Dim importFile As String
Dim InsertPoint As Variant
Dim scalefactor As Double
InsertPoint = ThisDrawing.Utility.GetPoint(, "Kattints a beillesztési ponthoz: ")
Set blockRefObj = ThisDrawing.Import("c:\wmf-k\" & fnev & ".wmf", InsertPoint, 2)
ZoomExtents
Load UserForm1
UserForm1.TextBox1.Text = "" & fnev & ""
UserForm1.Show
Kill "c:\wmf-k\" & fnev & ".wmf"
SaveAs ("l:\sw2010rajz\dxf-k szöveghez\k\" & fnev & ".dxf"), ac2000_dxf
ThisDrawing.Application.ActiveDocument.Close (True)
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing
End Sub
Private Sub CommandButton1_Click()
Dim AcadApp As AcadApplication
Dim MyDxf As AcadDocument
Set AcadApp = GetObject(, "AutoCAD.Application")
UserForm1.Hide
fnev = TextBox1.Text
Dim intFilterType(0) As Integer
Dim varFilterData(0)
intFilterType(0) = 0
varFilterData(0) = "Insert"
Dim explodedObjects As Variant
Dim I As Integer
I = 0
Dim objSSet As AcadSelectionSet
Dim blkEntry As AcadBlockReference
Do Until I = 1 'explodes all blocks
Set objSSet = ThisDrawing.SelectionSets.Add("Block")
objSSet.Select acSelectionSetAll, , , intFilterType, varFilterData
For Each blkEntry In objSSet
explodedObjects = blkEntry.Explode
Dim C As Integer
For C = 0 To UBound(explodedObjects)
explodedObjects(C).Update
explodedObjects(C).Color = acByLayer
explodedObjects(C).Lineweight = acLnWtByLayer
explodedObjects(C).Update
Next
blkEntry.Delete
Next blkEntry
ThisDrawing.SelectionSets.Item("Block").Delete
I = I + 1
Loop
End SubA programban lehet, hogy még vannak felesleges sorok de sebaj. a válaszokat előre is köszönöm.
[ Szerkesztve ]
-
martonx
veterán
válasz új kérdező #2439 üzenetére
Erre való mondjuk egy while ciklus, ami addig lépdel a sorokon lefelé, amíg az A oszlopban lát értéket.
sor = 1
while (cells(sor,1)<>"")
...
itt csinálok valamit
...
sor = sor + 1
end whileÉn kérek elnézést!
-
új kérdező
csendes tag
válasz martonx #2440 üzenetére
Köszi a választ. Maga a ciklus jó lenne, csak az a baj, hogy a userformal nem foglalkozik, azaz nem várja meg amíg az elvégzi a dolgát. Azaz a ciklus első lefutásakor megmutatja a formot de nem lehet rá kattintani csak miután a ciklus végzett, akkor meg már késő. És ez a probléma, hogy a Userformot is lehessen használni és mikor az végez akkor ugorjon a ciklus.
[ Szerkesztve ]
-
maxi19
újonc
Sziasztok.
Sulis beadandóm egy aknakereső játék megírása visual studio 2010 expresszel,sajnos nem nagyon vagyok otthon a témában,ezért kérnék segítséget.Magát a játék felületet még el tudom készíteni,de tovább nem tudom hogyan kéne menni?Ehhez kérnék segítséget -
maxi19
újonc
Első körben kipakolnék labeleket egy form felületre for ciklus segítségével.Majd randomgenerátorral kis akna képeket generálnék a labelek textjébe,utána pedig elrejteném valahogy őket.Első problémám máris az,hogy hogyan tudnék csak bizonyos label,textekbe aknákat generálni,mármint a randomgenerátor működését ismerem csak nem tudom hogy erre hogyan tudom azt ráfogni,illetve ha ez meg van,akkor az is kérdéses,hogy hogyan lehet azt elérni hogy az aknák kattintással megjelenjenek?
-
sztanozs
veterán
Ez elsőre jónak tűnik.
A legegyszerűbb, ha rögtön tömböt generálsz a labeleknek és a Tag tulajdonságba teszed az aknát.
Randommal le tudod generálni a véletlenszámokat, csak arra kell figyelni, hogy ahova tettél már aknát, oda megint ne kerüljön (kevesebb aknád lesz különben) - kb mint egy lottó húzásnál.JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...
-
sztanozs
veterán
válasz sztanozs #2445 üzenetére
Onclick-re megnézed, hogy van-e akna, ha van akkor robban, ha nincs akkor megnézed a szomszédokat és összeszámolod mennyiben van akna és az írod ki.
Arra az esetre ha nincs akna egy kicsit nehezebb megoldani, hogy szépen "kiürítse" a terepet, mint ahogy a windowsos aknakereső csinálja. De ha ez nincs bent a feladatban, akkor elég ha 0-t írsz ki.JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...
-
maxi19
újonc
Na random szám generálással kiosztottam véleltlenszerűen a helyeket ahol vannak illetve ahol nincsenek aknák.A kérdésem hogy azt hogyan lehet elérni,hogy ezek ne látszódjanak csak egy kattintásra illetve annak mi a módja,hogy ha nincs akna akkor körbejárjam a körötte levő mezőket és ősszeadjam az ott rejztőző aknákat majd kiírjam magába a mezőbe,tehát konkrétan a bejárás érdekelne?
-
sztanozs
veterán
Tag mezőbe rakod, hogy van-e akna és ott is ellenőrzöd le.
A módja a szomszédos mezők ellenőrzésének, hogy a labeleket tömbbe rakod és a tömb indexelésével tudod elérni a szomszédos mezőket.JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...
-
maxi19
újonc
válasz sztanozs #2448 üzenetére
Az nagy pofátlanság lenne tőlem ha segítséged kérném oly módon hogy megmutatom nked a kódot amit készítettem és ahhoz tennék fel kérdéseket,mert eléggé elakadtam most..és az idő meg nagyon szorít..a tanárom meg semmilyen mailre nem válaszol...
Ugyhogy most elég szarba vagyok...persze mondhatsz nemet....de ha naon naon segítesz nem lennék hálátlan..Nos?
Új hozzászólás Aktív témák
- Azonnali játékos kérdések órája
- VR topik (Oculus Rift, stb.)
- Assetto Corsa Competizione
- Székesfehérvár és környéke adok-veszek-beszélgetek
- Nagyon gyorsan betilthatja az EU a TikTok újítását
- Vezetékes FEJhallgatók
- Duotts F26 - megoldjuk erőből
- Visszaveszi az alapértelmezett tuningot az egyik csúcslapjában az ASUS
- callmeakos: A bukott koncepció, amiért háromszor is fizettem.
- HiFi műszaki szemmel - sztereó hangrendszerek
- További aktív témák...
- Alpine SBE-1044BR mélyláda, keveset használt
- !!! SZINTE ÚJ !!! LENOVO IdeaPad Gaming 3 Gamer laptop FHD/Core i5/16GB/512 GB SSD/RTX3050 4GB)
- Iphone 14 Pro sötétszürke - e-simes - mint az új - 100%
- UMIDIGI G5 Mecha 8GB/128GB Graphite Black
- Playstation 2 kontrollerek (PS2) - kék és Piros színben (DualShock II.)!