Új hozzászólás Aktív témák
-
válasz
Mzmatus
#3198
üzenetére
Bocs, nincs sok időm jelenleg (még mindig) PH-ra...
Utánaolvastam, olybá tűnik, hogy 2 megoldás lehet
1. .NET plugin írásával, akkor beépített funkciók érhetőek el
(Ez sem okoz gondot (mármint .NET plugin-t írnom, csak ahhoz viszont fel kell pattintanom mindenképp egy AutoCAD-t, talán hétvégén megsasolom)2. Hagyományos Winapi függvények használatával, sajna ez összetettebb mutatvány, több infó szükségeltetik hozzá (csomó paramétert és változót kell ismerni stb)
Ez utóbbit megmutatom hogyan kell elkövetni (x64-re/hez van deklarálva a fileopendialog import stb), ez univerzális kód -bár nem próbáltam AutoCAD-ben, mert nincs fent- ezért mennie kell 100%-ban, bármely VBA-ban is legyen.
A kód megnyitja a fájlablakot, szűrőt használ (DVB fájlokat listázza csak(rákerestem a neten, az újabb CAD-k ilyen kiterjesztéssel mentik a VBA kódot, ha meg esetleg mégsem, akkor a forrásban írd át a *.DVB-t *.*-ra, akkor minden fájl látszódni fog), ha egy ilyen fájlt kijelölsz, akkor kiírja a teljes útvonalával együtt, ha meg bezárod az ablakot, akkor meg, hogy nem jelöltél ki semmit... Szóval most ennyi fért az időmbe, ha lesz időm hétvégén folyt. köv.Option Explicit
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (MYOPENFILENAME As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type
Sub GetFileWithFullPath()
Dim MyOpenFile As OPENFILENAME
Dim MyResult As Long
With MyOpenFile
'kezdő drive/folder
.lpstrInitialDir = "D:\"
'fájlablak fejléce
.lpstrTitle = "Fire/SOUL/CD"
'fájlablak szűrő
.lpstrFilter = "AutoCAD VBA" & Chr$(0) & "*.dvb" & Chr$(0)
'default flag beállítás
.flags = 0
.nFilterIndex = 1
.hwndOwner = 0
.lpstrFile = String(257, 0)
.nMaxFile = LenB(.lpstrFile) - 1
.lStructSize = LenB(MyOpenFile)
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
End With
MyResult = GetOpenFileName(MyOpenFile)
If MyResult = 0 Then
MsgBox ("Nem választottál ki fájlt!")
Else
MsgBox (Trim(Left(MyOpenFile.lpstrFile, InStr(1, MyOpenFile.lpstrFile, vbNullChar) - 1)))
End If
End Sub
Új hozzászólás Aktív témák
- Ismét analóg billentyűzettel jelentkezett a Cherry Xtrfy
- Kötelező frissítésnek számít a Microsoft legújabb csomagja a Windows 11-hez
- sziku69: Fűzzük össze a szavakat :)
- Battlefield 6
- Kertészet, mezőgazdaság topik
- Milyen TV-t vegyek?
- Samsung Galaxy Felhasználók OFF topicja
- Mától Huawei okosórákkal is lehet érintésmentesen fizetni
- Okos otthon - Home Assistant, openHAB és más nyílt rendszerek
- Házimozi belépő szinten
- További aktív témák...
- Dell Latitude 5420/5430/5431/5440/7420/7430/7440 Magyar Világítós billentyűzet NTTG2
- Xiaomi 14 512GB, Kártyafüggetlen, 1 Év Garanciával
- PS4 Pro - CUH7216b - GoldHen BD-JB Lapse 1.2 - Samsung 500GB SSD
- HP OMEN X 35 X3W57AA
- Gigabyte GAMER-ke FullHD IPS Core i7(8 3,4Ghz),GTX 2/6GB DDR5 128BIT VGA,16GB RAM/560GB-1TB SSD
- Telefon felváráslás!! Samsung Galaxy S22/Samsung Galaxy S22+/Samsung Galaxy S22 Ultra
- GYÖNYÖRŰ iPhone 14 Pro Max 256GB Space Black-1 ÉV GARANCIA - Kártyafüggetlen, MS4143
- Azonnali készpénzes AMD Radeon RX 9000 sorozat videokártya felvásárlás személyesen/csomagküldéssel
- S21 256/8 dobozában
- Akció! Apple iMac 19.2 i5-8500 Radeon Pro 560X 4GB 16GB 256GB SSD 21.5" 4K Retina
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
