اگر در برنامه نمونه پیوست دقت کنین در واقع پاسخ اولیه مبحث Unbound Master/Detail Form رو هم پیدا میکنین!
دوستانی که مایل باشن میتونن عملیات insert/delete/update رو به فرم اضافه و در صورت تمایل با دیگران هم به اشتراک بگذارن.
اگر در برنامه نمونه پیوست دقت کنین در واقع پاسخ اولیه مبحث Unbound Master/Detail Form رو هم پیدا میکنین!
دوستانی که مایل باشن میتونن عملیات insert/delete/update رو به فرم اضافه و در صورت تمایل با دیگران هم به اشتراک بگذارن.
سلام و روز خوش
البته برنامه آماده cutting optimizer زیاد هست که mdfکار ها و برشکارها (فلز، پارچه، ...) از اون استفاده میکنن و حتی راه پارچه یا چوب رو هم میشه مشخص کرد.
در هر صورت اکسس ابزار مناسب این کار نیست، ولی شاید با visio بتونین یک کارهایی انجام بدین چون مستقیما ابجکت های گرافیکی سروکار دارهو
همچنین میتونین از addon های آماده autocad هم استفاده کنین یا خودتون بنویسن.
..........
آخرین ویرایش به وسیله eb_1345 : شنبه 09 مهر 1401 در 05:02 صبح
سلام جناب استاد mazoolagh عزیز!
هفته قبل تغییراتی بر روی نمونه ارزشمند جنابعالی در پست 81 همین صفحه ایجاد کردم . لطفاً بررسی بفرمائین ایرادی داره یا نه !
بالاخره آخرین فعالیت بنده در سایت برنامه نویس و در این تالار برمیگرده به 20 ماه پیش و بعد از این مدت احساس می کنم بخاطر عدم تمرین نسبت به گذشته تسلط کافی در زمینه کد نویسی نداشته باشم
یا علی
سلام
بنظرم تاپیک ایجاد نویگیشن باتن جهت تغییر صفحات گزارش باید در اینجا ایجاد میشد . چون سوالی که در این تاپیک پرسیده شده واقعا از جنس دیگریست ومن مشابه این سوال و راهکاری که برای اون ارائه گردیده جائی ندیده ام
هدف ساخت کوئری هست که 2 پارامتر از نوع long برای تعیین محدوده اعداد دریافت میکنه و خروجی اون همه اعداد در این محدوده است:
PARAMETERS Range_Start Long, Range_End Long;
SELECT ??? AS [Number]
FROM ???
WHERE ??? BETWEEN Range_Start AND Range_End;
- محدوده اعداد بین 1 تا 99999 است.
- اجازه استفاده از کد VBA نداریم!
- اجازه ساخت جدول حتی بصورت موقت نداریم!
Screenshot 2023-11-20 133740.png
Screenshot 2023-11-20 133916.png
Screenshot 2023-11-20 133949.png
سلام و روز خوشسلام
یعنی برای ایجاد این کوئری جدول خاصی هم وجود نداره ؟
آیا انجام ساخت چنین کوئری ای بدون وجود جدول امکان پذیره ؟
البته با کد میشه یک جدول ایجاد کرد ولی اشاره کرده این که نه اجازه استفاده از کد VBA وجود داره نه اجازه ساخت جدول حتی بصورت موقت
- شما از یک دیتابیس خالی Blank Database شروع میکنین،
- میتونین هرچند کوئری که لازم دارین قبلش آماده کنین (اگر نیاز هست - شاید نباشه!)،
ساختار کوئری خواسته شده همین هست که در پست قبلی آمده، کافی هست پیدا کنین به جای ??? ها چی باید باشه،
- ولی اجازه ساخت چیزی جز کوئری ندارین (جدول - شامل لینک شده هم میشه، فرم، گزارش، ماکرو، ماجول).
===========
با این وجود، جدولی رو که فکر میکنین نیاز دارین بگذارین تا در موردش بحث کنیم!
آخرین ویرایش به وسیله mazoolagh : سه شنبه 30 آبان 1402 در 18:07 عصر
تا پاسخ پرسش قبلی رو پیدا میکنین روی این یکی هم فکر کنین:
دیتابیس پیوست یک لیست از تقسیمات کشوری هست که به شکل پدر-فرزند ساخته شده (سلسله مراتبی یا hierarchical)
و دارای 103682 رکورد در 5 سطح استان/شهرستان/بخش/شهر/روستا(آبادی) هست:
Screenshot 2023-11-24 094718.png
هدف ساختن یک فرم جستجو هست که با گرفتن نام یک "جا" (Location) ،
مسیر همه جاهایی که شامل اون هستن رو به دو شکل مسیر IDها (Path) و مسیر Loacationها ($Path) نشون بده:
Screenshot 2023-11-24 100403.jpg
دریافت دیتابیس (1.2 مگابایت)
روش حل این مسئله در MS SQL
سلام و درود فراوان خدمت استادmazoolaghعزیز !
داده های دیتابیس شما رو در قالب treeview پیاده کردم
بخاطر زیاد بودن رکوردها تا حدودی با لود شدن اطلاعات بخصوص در هنگام باز شدن فرم مشکل دارم که سعی می کنم راهکاری براش پیدا کنم
در ضمن بلحاظ عدم مشارکت دوستان با اجازه شما فقط به ضمیمه نمودن دو تصویر از نمونه کار انجام شده اکتفا می کنم
آخرین ویرایش به وسیله eb_1345 : یک شنبه 05 آذر 1402 در 11:12 صبح
شرح مسیرها رو از طریق node.FullPath ایجاد کردم وسپس با استفاده از تابع Split اقدام به جداکردن سطوح مسیر که با علامت اسلش به همدیگر متصل شده اند نموده ا م و در مرحله آخر هم فراخوانی کد مربوط به شرح هر سطح از جدول و چسپاندن اونها به ترتیب سطوح شرح مسیر
TxtTitel.Value = node.FullPath
Pathsplit1 = Split(TxtTitel.Value, "\")(0) & "\"
TxtTitel.Value = Replace(TxtTitel.Value, Pathsplit1, "")
TxtTitel.Value = Replace(TxtTitel.Value, "\", "/")
CountWord1 = Len(TxtTitel.Value) - Len(Replace(TxtTitel.Value, "/", ""))
If CountWord1 = 0 Then
Strcode1 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(0) & "'")
TxtOstanCode = Strcode1
ElseIf CountWord1 = 1 Then
Strcode1 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(0) & "'")
Strcode2 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(1) & "'")
TxtOstanCode = Strcode2 & "/" & Strcode1
ElseIf CountWord1 = 2 Then
Strcode1 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(0) & "'")
Strcode2 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(1) & "'")
Strcode3 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(2) & "'")
TxtOstanCode = Strcode3 & "/" & Strcode2 & "/" & Strcode1
ElseIf CountWord1 = 3 Then
Strcode1 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(0) & "'")
Strcode2 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(1) & "'")
Strcode3 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(2) & "'")
Strcode4 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(3) & "'")
TxtOstanCode = Strcode4 & "/" & Strcode3 & "/" & Strcode2 & "/" & Strcode1
ElseIf CountWord1 = 4 Then
Strcode1 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(0) & "'")
Strcode2 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(1) & "'")
Strcode3 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(2) & "'")
Strcode4 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(3) & "'")
Strcode5 = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(4) & "'")
TxtOstanCode = Strcode5 & "/" & Strcode4 & "/" & Strcode3 & "/" & Strcode2 & "/" & Strcode1
End If
اگه بشه با ایجاد یک حلقه و استفاده از تعداد علامت های اسلش بکار رفته شده در شرح مسیر چند خط کد بالا رو به دوسه خط تبدیل کنم خیلی خوب میشه
مثلاً بصورت زیر:
For i = 0 To CountWord1
TxtOstanCode = DLookup("id", "TblLocations", "Location='" & Split(TxtTitel.Value, "/")(i) & "'")
Next
ولی ظاهراً یک شرطی باید در این حلقه اعمال کنم که نتیجه درست از آب دربیاد
فعلاً موضوعی دیگه ذهنم رو درگیر خودش کرده و نمیتونم درست و حسابی رو این موضوع تمرکز کنم
آخرین ویرایش به وسیله eb_1345 : یک شنبه 05 آذر 1402 در 12:46 عصر
سلام
کاش استاد mazoolagh کدهائی که در قسمت MS SQL بکار برده ان در اینجا تبدیل به کد sql که قابل اجرا در محیط اکسس باشه میکردن !
منظورم کدهای زیره:
USE [Iran]
GO
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE PROCEDURE [dbo].[GetParents]
@ID int
AS
BEGIN
SET NOCOUNT ON;
WITH All_Parents(ID) AS
(
SELECT ParentID FROM Locations WHERE ID=@ID
UNION ALL
SELECT L.ParentID
FROM All_Parents
INNER JOIN Locations AS L
ON All_Parents.ID=L.ID
)
SELECT L.ID, L.ParentID, L.[Location]
FROM All_Parents
INNER JOIN Locations AS L
ON All_Parents.ID = L.ID
END
GO
USE [Iran]
GO
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE PROCEDURE [dbo].[GetParentsPath]
@ID int
AS
BEGIN
SET NOCOUNT ON;
WITH All_Parents(ID) AS
(
SELECT ParentID FROM Locations WHERE ID=@ID
UNION ALL
SELECT L.ParentID
FROM All_Parents
INNER JOIN Locations AS L
ON All_Parents.ID=L.ID
)
SELECT
STRING_AGG (RESULTS.ID , '/') AS [PATH],
STRING_AGG (RESULTS.[Location] , '/') AS [PATH$]
FROM
(SELECT L.ID AS ID, L.ParentID, L.[Location]
FROM All_Parents
INNER JOIN Locations AS L
ON All_Parents.ID = L.ID) AS RESULTS
END
GO
آخرین ویرایش به وسیله atf1379 : شنبه 04 آذر 1402 در 19:02 عصر
سلام و درود فراوان خدمت mazoolaghعزیز !
داده های دیتابیس شما رو در قالب treeview پیاده کردم
بخاطر زیاد بودن رکوردها تا حدودی با لود شدن اطلاعات بخصوص در هنگام باز شدن فرم مشکل دارم که سعی می کنم راهکاری براش پیدا کنم
در ضمن بلحاظ عدم مشارکت دوستان با اجازه شما فقط به ضمیمه نمودن دو تصویر از نمونه کار انجام شده اکتفا می کنمسلام دوباره خدمت جناب بهرامی گرامیشرح مسیرها رو از طریق node.FullPath ایجاد کردم وسپس با استفاده از تابع Split اقدام به ایجاد کد مسیرها نمودم
و بسیار ممنون از این که در بحث ها شرکت میکنین و تجربه و دانش خودتون رو به اشتراک میگذارین.
به سهم خودم بابت همه چیزهایی که از شما یاد گرفتم سپاسگزارم.
طبق معمول همیشگی کارهای شما، یک طراحی و کدنویسی حرفه ای دیگه رو شاهد هستیم.
این که همه 103 هزار و اندی رکورد را گذاشتم 2 دلیل داشت:
1- دیتابیس کامل باشه شاید در جای دیگه ای نیاز کسی رو برآورده کنه.
2- بشه پرفورمنس و زمان پاسخ برنامه رو محک زد.
دیتابیس کامل (شامل Path و $Path های ساخته شده) رو خدمت شما و دیگر دوستان به پیوست تقدیم میکنم.
توجه داشته باشید که حجم فایل دانلودی 2.1 مگابایت هست که پس از بازکردن یک دیتابیس 86 مگابایتی خواهید داشت.
لطفا با این هم تست کنین .
دریافت دیتابیس کامل همراه با مسیرها
فرض کنید که یک جدول (یا کوئری)از همه اعداد مجاز long integer به اسم All_Numbers داشته باشیم:
minimum long integer = -(2^31) = -2,147,483,648
maximum long integer = 2^31 -1 = +2,147,483,647
البته منطقی نیست چون این جدول (یا کوئری) 4,294,967,296 رکورد خواهد داشت، ولی برای حل مسئله این فرض مشکلی ایجاد نمیکنه.
در اینصورت خیلی ساده کافی بود کوئری رو به شکل زیر میساختیم:
PARAMETERS Range_Start Long, Range_End Long;
SELECT N AS [Number]
FROM All_Numbers
WHERE N BETWEEN Range_Start AND Range_End;
که N اسم فیلد هست.
خب البته این کار شدنی نیست (منطقی و عملی) ،
ولی از ریاضی دبستان به یاد داریم که در سیستم شمارش دهدهی هر عددی را میتونیم با ارقام 0 تا 9 بسازیم،
به این صورت که دسته های یکی، ده تایی، سد تایی، هزار تایی، .... بسازیم (همون یکان، دهگان، سدگان، هزارگان، ...)
حالا کافی هست به جای یک جدول (کوئری) با بیش از 4 میلیارد رکورد،
برای هر دسته یک جدول (کوئری) فقط با 10 رکورد داشته باشیم. به عنوان مثال:
D با 10 رکورد از 0 تا 9
D10 با 10 رکورد از 0 تا 90
D100 با 10 رکورد از 0 تا 900
D1K با 10 رکورد از 0 تا 9000
D10K با 10 رکورد از 0 تا 90000
پس کوئری ما به شکل زیر میشه:
PARAMETERS Range_Start Long, Range_End Long;
SELECT (D.N + D10.N + D100.N + D1K.N + D10K.N) AS [Number]
FROM D,
D10,
D100,
D1K,
D10K
WHERE (D.N + D10.N + D100.N + D1K.N + D10K.N)
Between Range_Start And Range_End;
اما هنوز میتونیم کارها رو ساده تر کنیم،
به این صورت که فقط یک جدول(کوئری) D داشته باشیم ولی کوئری رو به شکل زیر بنویسیم:
PARAMETERS Range_Start Long, Range_End Long;
SELECT (D.N + 10*D10.N + 100*D100.N + 1000*D1K.N + 10000*D10K.N) AS [Number]
FROM D,
D AS D10,
D AS D100,
D AS D1K,
D AS D10K
WHERE (D.N + 10*D10.N + 100*D100.N + 1000*D1K.N + 10000*D10K.N)
BETWEEN Range_Start AND Range_End;
خب، الان دیگه فقط میمونه چجوری بدون این که جدولی بسازیم این کوئری D رو طراحی کنیم.
راستش ساختن این کوئری بدون داشتن یک جدول واقعی در دیتابیس شدنی نیست!
ولی خوشبختانه هر دیتابیس خودش یک سری جدول سیستمی داره که همین برای ما کافی هست.
2 راه داریم:
1- بدون توجه به دیتا جدول سیستمی، کوئری D رو بسازیم (فقط از اسمش استفاده کنیم):
SELECT TOP 1 (0) AS N FROM MSysAccessStorage
UNION
SELECT TOP 1 (1) AS N FROM MSysAccessStorage
UNION
SELECT TOP 1 (2) AS N FROM MSysAccessStorage
UNION
SELECT TOP 1 (3) AS N FROM MSysAccessStorage
UNION
SELECT TOP 1 (4) AS N FROM MSysAccessStorage
UNION
SELECT TOP 1 (5) AS N FROM MSysAccessStorage
UNION
SELECT TOP 1 (6) AS N FROM MSysAccessStorage
UNION
SELECT TOP 1 (7) AS N FROM MSysAccessStorage
UNION
SELECT TOP 1 (8) AS N FROM MSysAccessStorage
UNION
SELECT TOP 1 (9) AS N FROM MSysAccessStorage;
که در اینجا MSysAccessStorage یکی از جدول های سیستمی هست و میتونه هر کدوم از اون ها باشه،
چون ما به دیتا اون نیاز نداریم. بلکه اکسس هست که در UNION ما رو وادار به استفاده از FROM میکنه.
از TOP 1 هم برای بهتر کردن پرفورمنس استفاده کردیم که هر SELECT فقط یک رکورد برگردونه،
وگرنه هر SELECT به تعداد رکوردهای اون جدول مقدار 0 (تا 9) برمیگردونه که البته خود UNION تکراری ها رو کنار میگذاره و اینجا ما کارش رو راحت کردیم.
2- از دیتا خود جدول استفاده کنیم.
چند جدول سیستمی داریم که من بررسی کردم دیتا اون ها رو.
همین جدول MSysAccessStorage برای کار ما مناسب هست (خوشبختانه)
SELECT *FROM MSysAccessStorage
Screenshot 2023-11-26 192051.png
همینجور که میبینین فیلد ID کاملا مناسب کار ما هست،
پس خیلی ساده کوئری D به شکل زیر درمیاد:
SELECT (ID-1) AS N
FROM MSysAccessStorage
WHERE ID BETWEEN 1 AND 10
ORDER BY ID
پرسش برای بحث و تبادل نظر و ارائه شیوه های دیگه باز هست.
با سلام مجدد حضور استاد عزیز و دوست داشتنی!
سپاسگزارم !
یقیناً عنوان کردن این مطلب که چیزهائی از بنده یاد گرفته این بخاطر تواضع و فروتنی همیشگی شماست چرا که این مختصر علم و دانشی که بنده در زمینه کد نویسی آنهم صرفاً در محیط اکسس دارم از بزرگانی همچون جنابعالی یاد گرفته ام
در هر حال سپاسگزارم از لطف و محبتی که نسبت به این حقیر دارین
و اما در خصوص نکته ای که در خصوص پیدا کردن راهکاری برای کم کردن کدهای پست 96 اشاره کردم باید عرض کنم در کدهای فوق متوجه یک ایراد اساسی شدم و اون اینکه همونطور که در پست فوق اشاره کردم بدست آوردن مسیرکامل 5 سطح استان/شهرستان/بخش/شهر/روستا(آبادی) با استفاده از node.FullPath کار راحتیست و نیاز به هیچ کد نویسی ای نداره ولی بدست آوردن کدهای سطوح فوق نیازمند کدنویسی میباشد . در کدهای پست 96 بنده کد هر سطح رو با توجه به عنوان اون سطح در جدول بدست میاوردم و در شرح کامل 5 سطح ممکنه نام بعضی از سطوح کاملاً مشابه هم باشد . بعنوان مثال چهار سطح مسیر استان آذربایجان شرقی بصورت زیر میباشد :
آذربایجان شرقی/آذرشهر/حومه/آذرشهر
همانطور که ملاحظه میفرمائید عناوین سطح دوم و سوم کاملاً مشابه هم هستن و اگر بخواهیم از طریقDLookup کد عناوین فوق رو بدست بیاوریم برای هر دو عنوان یک کد مشابه خواهیم داشت
به همین لحاظ به دنبال راهکار دیگری گشتم . تا اینکه متوجه شدم که با توجه به سلسله مراتبی پدر و فرزندی در treeview آبجکت node در جایگاه فرزند داری یک node پدر میباشد و اون node پدر هم بسته به سطحی که در آن قرار دارد ممکنه خود فرزند باشه که خود دارای یک نود پدر باشد و به همین ترتیب . در ابزار تری ویو node پدر رو بصورت node.Parent شناسائی می کنیم و همین طور node پدر پدر (یا پدر بزرگ)رو بصورت و node.Parent.Parent
این خاصیت جالب ابزار تری ویو بنده رو بفکر واداشت که وقتی بر روی تری ویو کلیک می کنیم و node (گره) خاصی رو انتخاب می کنیم میتوانیم ضمن بدست آوردن کلید اون node کلید node های قبلی اون سطح رو هم استخراج کنیم
برای اینکار بنده اومدم 5 متغییر از نوع رشته با عناوین StrNode1 و StrNode2 و ..... تعریف کردم و هر کدوم از این متغییرها رو مساوی کلید گره جاری و گره های قبلی خود کردم
بصورت زیر:
StrNode1 = Right(Node.Key, Len(Node.Key) - 1)
StrNode2 = Right(Node.Parent.Key, Len(Node.Parent.Key) - 1)
StrNode3 = Right(Node.Parent.Parent.Key, Len(Node.Parent.Parent.Key) - 1)
StrNode4 = Right(Node.Parent.Parent.Parent.Key, Len(Node.Parent.Parent.Parent.Key) - 1)
StrNode5 = Right(Node.Parent.Parent.Parent.Parent.Key, Len(Node.Parent.Parent.Parent.Parent.Key) - 1)
در کلید هر گره یک حرف لاتین در سمت راست قرار دارد که بنده با استفاده از تابع Right این حرف رو حذف کردم
باید متذکر بشم که امکان اینکه این کلیدها رو فقط در یک متغییر قرار داد وجود داشت ولی بنده برای فهم دقیقتر کلید هر گرهی رو در یک متغییر جداگانه قرار داده ام و در نهایت گره ها بصورت سلسله مراتبی در کنار هم و با قرار دادن علامت"/" به هم چسبانده و در تکست باکس PathCode = StrNode1 & "/" & StrNode2 & "/" & StrNode3 & "/" & StrNode4 & "/" & StrNode5
که برای مسیر کدها ایجاد شده قرار دادم
بصورت زیز :
PathCode = StrNode1 & "/" & StrNode2 & "/" & StrNode3 & "/" & StrNode4 & "/" & StrNode5
از آنجائیکه اگر در هنگام کلیک کردن برروی treeview بطور مثال بر روی سطح 3 کلیک کنیم در اینجا متغییر های StrNode4 و StrNode5 خالی می مانند که در نهایت با استفاده از تابع Replace میتوان علامت "/" مربوط به جاهای خالی رو حذف کرد
کدهائی که در رویداد کلیک treeview برای بدست آورن مسیر سطوح بکار رفته بشرح زیر است:
Private Sub treeview1_NodeClick(ByVal Node As Object)
On Error Resume Next
Dim i As Integer
PathCode = ""
PathText = ""
StrNode1 = ""
StrNode2 = ""
StrNode3 = ""
StrNode4 = ""
StrNode5 = ""
PathText.value = Node.FullPath
Pathsplit = Split(PathText.value, "\")(0) & "\"
PathText.value = Replace(PathText.value, Pathsplit, "")
PathText.value = Replace(PathText.value, "\", "/")
StrNode1 = Right(Node.Key, Len(Node.Key) - 1)
StrNode2 = Right(Node.Parent.Key, Len(Node.Parent.Key) - 1)
StrNode3 = Right(Node.Parent.Parent.Key, Len(Node.Parent.Parent.Key) - 1)
StrNode4 = Right(Node.Parent.Parent.Parent.Key, Len(Node.Parent.Parent.Parent.Key) - 1)
StrNode5 = Right(Node.Parent.Parent.Parent.Parent.Key, Len(Node.Parent.Parent.Parent.Parent.Key) - 1)
PathCode = StrNode1 & "/" & StrNode2 & "/" & StrNode3 & "/" & StrNode4 & "/" & StrNode5
PathCode = Replace(PathCode, "//", "")
PathCode = Replace(PathCode, "/0/", "")
PathCode = Replace(PathCode, "/0", "")
End Sub
البته همونطور که جناب mazoolagh در اولین پست این تاپیک اشاره کردند هدف اصلی طرح مسائل و حل اون در این تاپیک شاید الزاما حل یک مساله کاربردی نباشه بلکه یک تمرین ذهنی و به چالش کشیدن توان کدنویسی و همچنین گریزی از امور تکراری و کسالت بار باشه وگرنه در حالت نمایش اطلاعات این دیتابیس بر روی فرم شاید اصلاً نیازی به نمایش کد مسیرها نباشه که بخاطر اون بخواهیم خودمون رو به زحمت بیندازیم و چند خط کد بنویسیم
آخرین ویرایش به وسیله eb_1345 : دوشنبه 06 آذر 1402 در 18:07 عصر
در مورد مسیریابی معمولا برعکس این مسئله است که اینجا مطرح شده؛البته همونطور که جناب mazoolagh در اولین پست این تاپیک اشاره کردند هدف اصلی طرح مسائل و حل اون در این تاپیک شاید الزاما حل یک مساله کاربردی نباشه بلکه یک تمرین ذهنی و به چالش کشیدن توان کدنویسی و همچنین گریزی از امور تکراری و کسالت بار باشه وگرنه در حالت نمایش اطلاعات این دیتابیس بر روی فرم شاید اصلاً نیازی به نمایش کد مسیرها نباشه که بخاطر اون بخواهیم خودمون رو به زحمت بیندازیم و چند خط کد بنویسیم
یعنی مسیر رو داریم و دنبال گره(ها) میگردیم.
و این همون کاری هست که XML/HTML Parser ها انجام میدن.
با اینحساب همین پرسش رو با JavaScript هم باید بتونیم انجام بدیم.
برای حل این مسئله ابتدا در نظر داشتم که نتایج رو در یک ListBox نمایش بدم (unbound - value list)
ولی چون اندازه دیتا ممکن هست از حداکثر طول رشته RowSource بیشتر باشه،
یک جدول به اسم Results برای نگهداری نتایج جستجو ساختم:
Screenshot 2023-11-28 194822.png
برای جستجو Location از روش استاندارد SELECT ... LIKE
و برای ساختن مسیرها هم از حلقه معمولی استفاده کردم.
کلا نکته خاصی برای توضیح بیشتر نیست.
Option Compare Database
Option Explicit
Private Type Path
IDs As String
Locations As String
End Type
Private rsL As Recordset
Const SQL = "SELECT ID, ParentID, Location FROM Locations WHERE Location LIKE '*@LOC*'"
Private Function GetPath(ID As Long) As Path
Dim P As Path
Const BackSlash = ""
Const EmptyPath = "-"
Dim Delimeter As String
Do While True
rsL.Seek "=", ID
ID = rsL("ParentID")
If ID = -1 Then
Exit Do
Else
P.Locations = P.Locations + Delimeter + rsL("Location")
P.IDs = P.IDs + Delimeter + CStr(ID)
Delimeter = BackSlash
End If
Loop
If P.Locations = "" Then
P.IDs = EmptyPath
P.Locations = EmptyPath
End If
GetPath = P
End Function
Private Sub BTN_Search_Click()
If Nz(TB_Search, "") = "" Then Exit Sub
If Len(Trim(TB_Search)) < 2 Then Exit Sub
Debug.Print Now
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(Replace(SQL, "@LOC", TB_Search), dbOpenSnapshot, dbReadOnly)
If rs.EOF Then GoTo Exit_Sub
DoCmd.Hourglass True
DoCmd.RunSQL "DELETE FROM RESULTS"
Dim N, Row As Long
rs.MoveLast
rs.MoveFirst
N = rs.RecordCount
SysCmd acSysCmdInitMeter, N & " Records found ...", N
Dim rsR As Recordset
Set rsR = CurrentDb.OpenRecordset("Results")
Do While Not rs.EOF
Row = rs.AbsolutePosition + 1
Dim P As Path
P = GetPath(rs("ID"))
rsR.AddNew
rsR("Row") = Row
rsR("Location") = rs("Location")
rsR("ID") = rs("ID")
rsR("Path$") = P.Locations
rsR("Path") = P.IDs
rsR.Update
SysCmd acSysCmdUpdateMeter, Row
rs.MoveNext
DoEvents
Loop
rsR.Close: Set rsR = Nothing
SysCmd acSysCmdRemoveMeter
DoCmd.Hourglass False
Debug.Print Now
DoCmd.OpenForm "Results", , , , , acDialog, "(" & TB_Search & ") " & N & " رکورد"
Exit_Sub:
rs.Close: Set rs = Nothing
End Sub
Private Sub Form_Close()
rsL.Close
Set rsL = Nothing
End Sub
Private Sub Form_Load()
Set rsL = CurrentDb.OpenRecordset("Locations", dbOpenTable, dbReadOnly)
rsL.Index = "PrimaryKey"
End Sub
Screenshot 2023-11-28 201954.png
سلام و روز خوش
بخش بزرگی از پاسخ رو جناب بهرامی پایین پست شماره 102 آوردن و دیگه تکرار نمیکنم.
ولی این مسئله (که اتفاقا خیلی هم هم راحت هست - کلا 2 کوئری 4-5 خطی بیشتر نیست) راهی بجز این نداره.
شما حتی اگر اجازه ساخت جدول رو هم میداشتین نهایتا برای D مفید بود،
باز باید از این کوئری استفاده میکردین.
اما در مورد کاربردش؛
این رو به عهده زمان میگذارم - دیر یا زود برخورد میکنین؛
شاید دقیقا خود این نباشه ولی روش همین خواهد بود.
عنوان به اندازه گافی گویا هست:
میخواهیم دیتا جدول/کوئری رو صفحه بندی کنیم و هر صفحه رو پس از مدت زمان معینی نمایش بدیم.
1- ابتدا یک فرم باید باز بشه که در اون امکان انتخاب موارد زیر باشه:
2- لیست جدول ها و کوئری ها (چه جدول های local و چه linked)
3- انتخاب شماره رکوردها در هر صفحه
4- انتخاب زمان نمایش هر صفحه
5- انتخاب نوع انیمیشن یا افکت هنگام عوض شدن صفحه (مثلا fade-in/fade-out یا zoom-in/zoom-out و ...)
6- انتخاب مدت زمان هر افکت
7- انتخاب نمایش ساعت (بر اساس گاهشمار ایرانی) در پایین صفحه
8- بهتر هست دست کم یک تم theme برای نمایش نتایج وجود داشته باشه.
9- یک progress باید برای نمایش وضعیت وجود داشته باشه : هم متنی به صورت صفحه ... از .. و هم گرافیک
10 - پس از آن با زدن یک باتن محاسبات انجام و نتایج در یک فایل html ساخته شده و فرمی که دارای کنترل web browser هست اون رو نمایش میده.
----------
بهتر هست یادآوری کنم که این پرسش جنبه عملی چندانی نداره!
چون دیتا نمایش داده استاتیک هست،
و این که از 30 سال پیش با asp معمولی هم میشد این رو ساخت (البته بدون افکت و ...)
ولی چالشی هست که چگونه با کنترل web browser که بر مبنای ie7 هست و در حالت عادی این امکانات رو نداره جواب بگیریم.
و این که برای نوشتن این برنامه لازم هست به HTML/CSS/JavaScript مسلط باشین (آشنایی کافی نیست - ولی لازم هست)
کاملا مشخص هست که هیچکس به این مسئله اصلا فکر نکرده!
همون مورد 2 ( لیست جدول ها و کوئری ها (چه جدول های local و چه linked) ) به تنهایی یک پرسش نه چندان ساده است.
........................................
آخرین ویرایش به وسیله atf1379 : یک شنبه 03 دی 1402 در 00:13 صبح
با کدهای زیر نام جداول (غیر از جداول سیستمی ) به لیست باکس اضافه میشه :
Dim tbl As TableDef
For Each tbl In CurrentDb.TableDefs
If Left(tbl.Name, 4) <> "Msys" Then
List.RowSource = List.RowSource & ";" & tbl.Name
End If
Next
List.RowSource = Mid(List.RowSource, 2)
و با کدهای زیر نام کوئری ها به لیست باکس اضافه میشه :
Dim qdf As QueryDef
For Each qdf In CurrentDb.QueryDefs
If Left(qdf.Name, 1) <> "~" Then
List.RowSource = List.RowSource & ";" & qdf.Name
End If
Next
List.RowSource = Mid(List.RowSource, 2)
سلام دوباره و روز شما خوش
بسیار عالی و دقیق!
من جدولی که شما زحمتش رو کشیدین همینجا پیوست میکنم و
یک توضیح مختصر هم میدم در موردش:
اطلاعات آبجکت های اکسس در جدول MsysObjects (همراه با چند جدول سیستمی دیگه) نگه داری میشه ولی اصلی همین MsysObjects ه.
مایکروسافت به دلایل کاملا مشخص، اطلاعات اینها رو مستند نکرده و این جدول tblSysObjectTypesکه جناب بهرامی زحمتش رو کشیدن یکی از بهترین هاست،
چون تمام آبجکت ها رو در بر میگیره و کار رو بسیار راحت میکنه و دیگه نیازی نیست خودمون در MsysObjects بگردیم.
بخصوص که انواع کوئری رو هم در بر میگیره و خیلی جاها مهم هست که بدونیم کوئری ما رکورد برمیگردونه یا نه (یکیش همین پرسش پست 107)
پیشنهاد میکنم هر کس این تاپیک رو میخونه پیوست پست 111 رو دانلود کنه و یک جایی نگه داره چون دیر یا زود بهش نیاز پیدا میکنه.
Object Type SubType Flags Hidden System Form -32768
0 0 0 Macro -32766
0 0 0 Report -32764
0 0 0 Module -32761
0 0 0 Users -32758
0 -1 Document -32757
0 -1 Data Access Page -32756
0 0 Table 1 Local 8 -1 0 Table 1 System
0 -1 Table 1 Local 0 0 0 Database 2
0 -1 Container 3
0 -1 Table 4 Linked SQL 537919496 -1 0 Table 4 Linked SQL 537919488 0 0 Query 5 Append 72 -1 0 Query 5 Append 64 0 0 Query 5 Crosstab 24 -1 0 Query 5 Crosstab 16 0 0 Query 5 Data Definition 96 0 0 Query 5 Data Definition 104 -1 0 Query 5 Delete 40 -1 0 Query 5 Delete 32 0 0 Query 5 Make Table 80 0 0 Query 5 Make Table 88 -1 0 Query 5 Pass Through 112 0 0 Query 5 Pass Through 120 -1 0 Query 5 Select 8 -1 0 Query 5 Select 0 0 0 Form/Report Module 5
3 0 0 Query 5 Union 128 0 0 Query 5 Union 136 -1 0 Query 5 Update 56 -1 0 Query 5 Update 48 0 0 Table 6 Linked Access 538968064 0 0 Table 6 Linked Text / CSV 10485760 0 0 Table 6 Linked Excel 11534336 0 0 Table 6 Linked Excel 11534344 -1 0 Table 6 Linked Text / CSV 10485768 -1 0 Table 6 Linked Access 538968072 -1 0 Table 6 Linked Access 2097152 0 0 SubDatasheet 8
0 -1 Table 1 System -2147483648 0 -1 Table 1 System -2147287040 -1 -1 Relationships 8
0 0 0
خب، با توجه به پست بالا برای حل پرسش پست 107 باید آبجکت هایی از جدول MSysObjects رو لیست کنیم که:
- Name اون ها با MSys شروع نمیشه (سیستمی)
- Name اون ها با ~ شروع نمیشه (موقت temp)
- Type=1 با flag>=0 (جدول لوکال)
- Type=4 (جدول لینک شده ODBC)
- Type=6 (جدول لینک شده)
- Type=5 با flag=0,8,16,24,128,136 (کوئری select, crosstab, union)
توضیح این که آبجکت های مخفی در flag شون 8 تا با معمولی تفاوت دارن.
پس کوئری ما چیزی شبیه به زیر میشه:
SELECT [NAME], [TYPE], [FLAGS]
FROM MSYSOBJECTS
WHERE [NAME] NOT LIKE "MSYS*" AND
[NAME] NOT LIKE "~*" AND
( ([TYPE] IN (1,4,6) AND [FLAGS]>=0) OR
[TYPE]=5 AND FLAGS IN(0,8,16,24,128,136) )
ORDER BY [TYPE], [NAME];
نتیجه تست کوئری :
Screenshot 2023-12-25 114156.png
Screenshot 2023-12-25 114244.png
با توجه به آموزش لیست همه جدولها / کوئریها و فیلدهای آنها List of All Tables/Queries and their Fields ،
گام اول که پر کردن لیست باکس های data source و fields هست به سادگی انجام میشه:
Screenshot 2024-01-03 202600.png
Option Compare Database
Option Explicit
Private DataSources As New Collection
Private Sub Form_Close()
Set DataSources = Nothing
End Sub
Private Sub Form_Load()
Dim CountTables As Integer
Dim CountLinkedTables As Integer
Dim CountQueries As Integer
Dim i As Integer
Dim x As New Collection
Set x = GetTables
For i = 1 To x.Count
DataSources.Add x.Item(i)
Me.LB_Sources.AddItem x.Item(i).SourceName & ";" & x.Item(i).SourceType
If x.Item(i).SourceType = "Table" Then
CountTables = CountTables + 1
Else
CountLinkedTables = CountLinkedTables + 1
End If
Next
Set x = GetQueries
For i = 1 To x.Count
With x.Item(i)
If .Fields.Count > 0 Then
DataSources.Add x.Item(i)
Me.LB_Sources.AddItem .SourceName & ";" & .SourceType
CountQueries = CountQueries + 1
End If
End With
Next
With Me.LB_Sources
If .ListCount > 1 Then
.Value = .ItemData(0)
LB_Sources_AfterUpdate
End If
End With
Me.LBL_Sources_Summary.Caption = _
"Tables=" & CountTables & _
" ; Linked Tables=" & CountLinkedTables & _
" ; Queries=" & CountQueries
End Sub
Private Sub LB_Sources_AfterUpdate()
Dim index As Integer
index = Me.LB_Sources.ListIndex
Dim i As Integer
With DataSources.Item(index + 1)
Me.LB_Fields.RowSource = .FieldsString
Me.LBL_Connect.Caption = .connect
Me.LBL_Fields_Summary.Caption = "Fields Count=" & .Fields.Count & " , Records Count=" & DCount("*", .SourceName)
End With
End Sub
در گام بعدی امکانات انتخاب فیلدها از بین فیلدهای data source و ترتیب ستون بندی (نه ترتیب سورت!) رو اضافه میکنیم:
Private Sub BTN_None_Click()
Me.LB_SelectedFields.RowSource = ""
End Sub
Private Sub BTN_All_Click()
Me.LB_SelectedFields.RowSource = ""
Dim index As Integer
index = Me.LB_Sources.ListIndex
Dim i As Integer
Dim FieldsCount As Integer
With DataSources.Item(index + 1).Fields
FieldsCount = .count
For i = 1 To FieldsCount
If Not (.Item(i).FieldType Like "*Binary*" Or .Item(i).FieldType = "Attachment") Then
Me.LB_SelectedFields.AddItem .Item(i).FieldName
End If
Next
End With
End Sub
Private Sub BTN_Add_Click()
Dim SelectedField As String
Dim FieldType As String
Dim i As Integer
With Me.LB_Fields
If .ListIndex < 0 Then
.Value = .ItemData(0)
End If
SelectedField = .Value
FieldType = .Column(1)
If (FieldType Like "*Binary*" Or FieldType = "Attachment") Then
MsgBox "Attachment and Binary fields not allowed!", vbExclamation, "Invalid field type"
Exit Sub
End If
For i = 0 To .ListCount - 1
If Me.LB_SelectedFields.ItemData(i) = SelectedField Then Exit Sub
Next
Me.LB_SelectedFields.AddItem SelectedField
Me.LB_SelectedFields.Value = SelectedField
If .ListIndex < .ListCount - 1 Then
.Value = .ItemData(.ListIndex + 1)
End If
End With
End Sub
Private Sub BTN_Remove_Click()
Dim index As Integer
With Me.LB_SelectedFields
If .ListIndex < 0 Then
.Value = .ItemData(0)
End If
index = .ListIndex
.RemoveItem (index)
If index > .ListCount - 1 Then
index = .ListCount - 1
End If
.Value = .ItemData(index)
End With
End Sub
Private Sub BTN_Up_Click()
Dim index As Integer
With Me.LB_SelectedFields
index = .ListIndex
If index <= 0 Or .ListCount = 1 Then Exit Sub
Dim vlu As String
vlu = .Value
.RemoveItem (index)
.AddItem vlu, index - 1
.Value = vlu
End With
End Sub
Private Sub BTN_Down_Click()
Dim index As Integer
With Me.LB_SelectedFields
index = .ListIndex
If index = .ListCount - 1 Then Exit Sub
Dim vlu As String
vlu = .Value
.RemoveItem (index)
.AddItem vlu, index + 1
.Value = vlu
End With
End Sub
Screenshot 2024-01-06 194951.jpg
در مرحله آخر بخش مربوط به انتخاب پارامترها رو اضافه میکنیم:
- نوع انیمیشن
- زمان انیمیشن
- تعداد رکورد در هر صفحه (در کد اگر از 100 بیشتر بشه اون رو به 100 محدود کردیم که حجم فایل html و البته زمان ساخت طولانی نباشه)
- زمان نمایش هر صفحه
- تم
- نحوه نمایش مقادیر Boolean
- اضافه کردن شماره ردیف
effects.png
نوع انیمیشن:
animation.png
تم:
theme.png
نحوه نمایش فیلدهای Boolean:
booleans.png
checkbox
checkbox.png
toggle button
toggle.png
radio button
radio.png
on/off
onoff.png
yes/no
yesno.png
true/false
truefalse.png
row number
row.png
date/time
datetime.png