خارج از دستور - پرسشهایی از جنس دیگر

خب، الان دیگه فقط میمونه چجوری بدون این که جدولی بسازیم این کوئری 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

ضمیمه 155074

همینجور که میبینین فیلد ID کاملا مناسب کار ما هست،
پس خیلی ساده کوئری D به شکل زیر درمیاد:

SELECT (ID-1) AS N

FROM MSysAccessStorage

WHERE ID BETWEEN 1 AND 10

ORDER BY ID

پرسش برای بحث و تبادل نظر و ارائه شیوه های دیگه باز هست.

نقل قول:

---

نوشته شده توسط mazoolagh

به سهم خودم بابت همه چیزهایی که از شما یاد گرفتم سپاسگزارم.

---

با سلام مجدد حضور استاد عزیز و دوست داشتنی!
سپاسگزارم !
یقیناً عنوان کردن این مطلب که چیزهائی از بنده یاد گرفته این بخاطر تواضع و فروتنی همیشگی شماست چرا که این مختصر علم و دانشی که بنده در زمینه کد نویسی آنهم صرفاً در محیط اکسس دارم از بزرگانی همچون جنابعالی یاد گرفته ام
در هر حال سپاسگزارم از لطف و محبتی که نسبت به این حقیر دارین
و اما در خصوص نکته ای که در خصوص پیدا کردن راهکاری برای کم کردن کدهای پست 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 در اولین پست این تاپیک اشاره کردند هدف اصلی طرح مسائل و حل اون در این تاپیک شاید الزاما حل یک مساله کاربردی نباشه بلکه یک تمرین ذهنی و به چالش کشیدن توان کدنویسی و همچنین گریزی از امور تکراری و کسالت بار باشه وگرنه در حالت نمایش اطلاعات این دیتابیس بر روی فرم شاید اصلاً نیازی به نمایش کد مسیرها نباشه که بخاطر اون بخواهیم خودمون رو به زحمت بیندازیم و چند خط کد بنویسیم

نقل قول:

---

نوشته شده توسط mazoolagh

پرسش برای بحث و تبادل نظر و ارائه شیوه های دیگه باز هست.

---

با سلام
سوالی که ممکنه برای خیلی از دوستان مطرح باشه انست که با توجه به ایجاد راحت و بی دردسر کوئری از انواع جداول چه نیازی به ساخت چنین کوئری ای داریم که ایجاد اون آنچنان هم راحت نیست .
در کل استفاده از این نوع کوئری در کجا و چه حالتی مفیده ؟
با تشکر

نقل قول:

---

البته همونطور که جناب mazoolagh در اولین پست این تاپیک اشاره کردند هدف اصلی طرح مسائل و حل اون در این تاپیک شاید الزاما حل یک مساله کاربردی نباشه بلکه یک تمرین ذهنی و به چالش کشیدن توان کدنویسی و همچنین گریزی از امور تکراری و کسالت بار باشه وگرنه در حالت نمایش اطلاعات این دیتابیس بر روی فرم شاید اصلاً نیازی به نمایش کد مسیرها نباشه که بخاطر اون بخواهیم خودمون رو به زحمت بیندازیم و چند خط کد بنویسیم

---

در مورد مسیریابی معمولا برعکس این مسئله است که اینجا مطرح شده؛
یعنی مسیر رو داریم و دنبال گره(ها) میگردیم.
و این همون کاری هست که XML/HTML Parser ها انجام میدن.
با اینحساب همین پرسش رو با JavaScript هم باید بتونیم انجام بدیم.

برای حل این مسئله ابتدا در نظر داشتم که نتایج رو در یک ListBox نمایش بدم (unbound - value list)

ولی چون اندازه دیتا ممکن هست از حداکثر طول رشته RowSource بیشتر باشه،
یک جدول به اسم Results برای نگهداری نتایج جستجو ساختم:

ضمیمه 155082

برای جستجو 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

ضمیمه 155083

نقل قول:

---

نوشته شده توسط atf1379

با سلام
سوالی که ممکنه برای خیلی از دوستان مطرح باشه انست که با توجه به ایجاد راحت و بی دردسر کوئری از انواع جداول چه نیازی به ساخت چنین کوئری ای داریم که ایجاد اون آنچنان هم راحت نیست .
در کل استفاده از این نوع کوئری در کجا و چه حالتی مفیده ؟
با تشکر

---

سلام و روز خوش
بخش بزرگی از پاسخ رو جناب بهرامی پایین پست شماره 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 مسلط باشین (آشنایی کافی نیست - ولی لازم هست)

نقل قول:

---

نوشته شده توسط mazoolagh

عنوان به اندازه گافی گویا هست:
میخواهیم دیتا جدول/کوئری رو صفحه بندی کنیم و هر صفحه رو پس از مدت زمان معینی نمایش بدیم.

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) ) به تنهایی یک پرسش نه چندان ساده است.

........................................

نقل قول:

---

نوشته شده توسط mazoolagh

کاملا مشخص هست که هیچکس به این مسئله اصلا فکر نکرده!

همون مورد 2 ( لیست جدول ها و کوئری ها (چه جدول های local و چه linked) ) به تنهایی یک پرسش نه چندان ساده است.

---

سلام
در ارتباط با مورد 2 فکر کنم نمونه ضمیمه بدرد بخوره

با کدهای زیر نام جداول (غیر از جداول سیستمی ) به لیست باکس اضافه میشه :

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)

نقل قول:

---

نوشته شده توسط eb_1345

سلام
در ارتباط با مورد 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];

نتیجه تست کوئری :

ضمیمه 155175

ضمیمه 155176

نقل قول:

---

نوشته شده توسط eb_1345

با کدهای زیر نام جداول (غیر از جداول سیستمی ) به لیست باکس اضافه میشه :

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)

---

خیلی خوب شد که این رو هم مطرح کردین.

استفاده از tabledefs/querydefs نسبت به چرخیدن در MSysObjects راه تمیزتری هست و Hacky هم نیست!

در برنامه نهایی هر دو روش هست برای مقایسه و یادگیری.

با توجه به آموزش لیست همه جدول‌ها / کوئری‌ها و فیلدهای آنها List of All Tables/Queries and their Fields ،
گام اول که پر کردن لیست باکس های data source و fields هست به سادگی انجام میشه:

ضمیمه 155207

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

ضمیمه 155211

در مرحله آخر بخش مربوط به انتخاب پارامترها رو اضافه میکنیم:

• نوع انیمیشن
• زمان انیمیشن
• تعداد رکورد در هر صفحه (در کد اگر از 100 بیشتر بشه اون رو به 100 محدود کردیم که حجم فایل html و البته زمان ساخت طولانی نباشه)
• زمان نمایش هر صفحه
• تم
• نحوه نمایش مقادیر Boolean
• اضافه کردن شماره ردیف

ضمیمه 155217

نوع انیمیشن:
ضمیمه 155218

تم:
ضمیمه 155219

نحوه نمایش فیلدهای Boolean:

ضمیمه 155221

checkbox
ضمیمه 155222

toggle button
ضمیمه 155223

radio button
ضمیمه 155224

on/off
ضمیمه 155225

yes/no
ضمیمه 155226

true/false
ضمیمه 155227

row number
ضمیمه 155228

date/time
ضمیمه 155229

کد کامل فرم Main

Option Compare Database

Option Explicit

    

Private DataSources As New Collection

Private RecordsCount As Long





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

    Me.LB_SelectedFields.RowSource = ""

    With DataSources.Item(index + 1)

        RecordsCount = DCount("*", .SourceName)

        Me.LB_Fields.RowSource = .FieldsString

        Me.LBL_Connect.Caption = .connect

        Me.LBL_Fields_Summary.Caption = "Fields Count=" & .Fields.count & " , Records Count=" & RecordsCount

    End With

    Validate

End Sub





Private Sub BTN_None_Click()

    Me.LB_SelectedFields.RowSource = ""

    Validate

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

    Validate

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

    Validate

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

    Validate

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





Private Sub Validate()

    Me.BTN_Go.Enabled = (RecordsCount > 0 And Me.LB_SelectedFields.ListCount > 0)

End Sub





Private Sub BTN_Go_Click()

    Dim fso As New FileSystemObject

    Dim fl As TextStream

    Dim rs As Recordset

    Dim n As Long

    Dim i As Integer

    Dim j As Integer

    Dim k As Integer

    Dim m As Integer

    Dim Path As String

    Dim PageSize As Integer

    Dim PagesCount As Integer

    Dim AnimationType As String

    Dim SQL As String

    

    AnimationType = Replace(Me.CB_AnimationType, " ", "")

    

    Path = CurrentProject.Path + "\html"

    PageSize = Me.CB_PageSize

    

    Dim x As Variant

    x = Split(Me.LB_SelectedFields.RowSource, ";")

    For i = LBound(x) To UBound(x)

        x(i) = "[" & x(i) & "]"

    Next

    SQL = "SELECT " & Join(x, ",") & " FROM [" & Me.LB_Sources & "]"

    Set rs = CurrentDb.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges + dbReadOnly)

    rs.MoveLast

    rs.MoveFirst

    n = rs.RecordCount

    PagesCount = n / PageSize

    

    If PagesCount > 100 Then

        PagesCount = 100

        ' limit the page to a maximum of 100 to keep the html file at a reasonable size

    ElseIf PagesCount * PageSize < n Then

        PagesCount = PagesCount + 1

    End If

    

    If Not fso.FolderExists(Path) Then

        fso.CreateFolder (Path)

    End If

    Set fl = fso.CreateTextFile( _

                FileName:=Path + FileName, _

                overwrite:=True, _

                unicode:=True)

    

    fl.write HTML_Start

    m = 0

    For i = 1 To PagesCount

        If AnimationType = "None" Then

            If i = 1 Then

                fl.WriteLine "<div id='page_1' class='page visible'>"

            Else

                fl.WriteLine "<div id='page_" + Trim(i) + "' class='page hidden'>"

            End If

        Else

            If i = 1 Then

                fl.WriteLine "<div id='page_1' class='page visible " & AnimationType & "_in'>"

            Else

                fl.WriteLine "<div id='page_" + Trim(i) + "' class='page hidden " & AnimationType & "_out'>"

            End If

        End If

        

        Select Case Me.CB_Theme

            Case "Mixed"

                Select Case i Mod 4

                    Case 0

                        fl.WriteLine "<table class='orange'>"

                    Case 1

                        fl.WriteLine "<table class='green'>"

                    Case 2

                        fl.WriteLine "<table class='blue'>"

                    Case 3

                        fl.WriteLine "<table class='black'>"

                End Select

            Case Else

                fl.WriteLine "<table class='" & LCase(Me.CB_Theme) & "'>"

        End Select

        

        fl.write "<thead><tr>"

        If Me.CHK_RowNumber Then

            fl.write "<th>#</th>"

        End If

        For j = 1 To rs.Fields.count

            fl.write "<th>" + rs.Fields(j - 1).Name + "</th>"

        Next

        fl.write "</tr>"

        fl.WriteLine "</thead>"

        fl.WriteLine "<tbody>"

        For j = 1 To PageSize

            If rs.EOF Then Exit For

                If Me.CHK_RowNumber Then

                    m = m + 1

                    fl.write "<tr><td>" + Trim(m) + "</td>"

                End If

                For k = 1 To rs.Fields.count

                    If rs.Fields(k - 1).Type = dbBoolean Then

                        Select Case Me.CB_Booleans

                            Case "CheckBox"

                                If rs.Fields(k - 1).Value Then

                                    fl.write "<td><input type='checkbox' checked></td>"

                                Else

                                    fl.write "<td><input type='checkbox'></td>"

                                End If

                            Case "Toggle"

                                If rs.Fields(k - 1).Value Then

                                    fl.write "<td><label class='switch'><input type='checkbox' checked><span class='slider'></span></label></td>"

                                Else

                                    fl.write "<td><label class='switch'><input type='checkbox'><span class='slider'></span></label></td>"

                                End If

                            Case "Radio"

                                If rs.Fields(k - 1).Value Then

                                    fl.write "<td><input type='radio' checked></td>"

                                Else

                                    fl.write "<td><input type='radio'></td>"

                                End If

                            Case "Yes/No"

                                If rs.Fields(k - 1).Value Then

                                    fl.write "<td>Yes</td>"

                                Else

                                    fl.write "<td>No</td>"

                                End If

                            Case "On/Off"

                                If rs.Fields(k - 1).Value Then

                                    fl.write "<td>On</td>"

                                Else

                                    fl.write "<td>Off</td>"

                                End If

                            Case Else ' default True/False

                                fl.write "<td>" & rs.Fields(k - 1) & "</td>"

                        End Select

                    Else

                        fl.write "<td>" & rs.Fields(k - 1).Value & "</td>"

                    End If

                Next

            fl.WriteLine "</tr>"

            rs.MoveNext

        Next

        fl.WriteLine "</tbody>"

        fl.WriteLine "</table>"

        fl.WriteLine "</div>"

        DoEvents

    Next

    rs.Close

    Set rs = Nothing

    Dim xEnd As String

    xEnd = Replace(HTML_End, "@PAGE_LIFE", 1000 * Me.CB_PageLife)

    If AnimationType = "None" Then

        xEnd = Replace(xEnd, "@ANIMATION_DURATION", "0s")

        xEnd = Replace(xEnd, "@ANIMATION_TYPE_in", "")

        xEnd = Replace(xEnd, "@ANIMATION_TYPE_out", "")

    Else

        xEnd = Replace(xEnd, "@ANIMATION_DURATION", Me.CB_AnimationDuration & "s")

        xEnd = Replace(xEnd, "@ANIMATION_TYPE", AnimationType)

    End If

    

    fl.write xEnd

    fl.Close

    Set fso = Nothing

    

    DoCmd.OpenForm "Browser"

End Sub

کد کامل فرم Browser

Option Compare Database

Option Explicit





Private Sub Form_Load()

    DoCmd.Maximize

    WB.ControlSource = "=""" & CurrentProject.Path & "\html" & FileName & """"

End Sub





Private Sub Form_Resize()

    WB.width = Me.InsideWidth

    WB.Height = Me.InsideHeight

End Sub

HTML Module

Option Compare Database

Option Explicit



Public Const FileName = "pager.html"



Public Const Script = _

        "<script>" + vbCrLf + _

        "const pages = document.querySelectorAll('[id^=page_]');" + vbCrLf + _

        "const bar = document.getElementById('bar');" + vbCrLf + _

        "const bartext = document.getElementById('bar-text');" + vbCrLf + _

        "const clock = document.getElementById('clock');" + vbCrLf + _

        "const timeOptions = {year:'numeric',month:'long',day:'numeric',weekday  :'long',hour:'2-digit',minute:'2-digit',second:'2-digit'};" + vbCrLf + _

        "const n = pages.length;" + vbCrLf + _

        "setClock();" + vbCrLf + _

        "bar.style.transitionDuration = '@ANIMATION_DURATION';" + vbCrLf + _

        "for (i = 0; i < n; i++) { pages[i].style.transitionDuration = '@ANIMATION_DURATION'; };" + vbCrLf + _

        "var i = 0;" + vbCrLf + _

        "setBar(i);" + vbCrLf + _

        "setInterval(setClock, 1000);" + vbCrLf + _

        "setInterval(function () {" + vbCrLf + _

        "pages[i].className = 'page hidden @ANIMATION_TYPE_out';" + vbCrLf + _

        "i = (i == (n - 1)) ? 0 : i + 1;" + vbCrLf + _

        "pages[i].className = 'page visible @ANIMATION_TYPE_in';" + vbCrLf + _

        "setBar(i);}, @PAGE_LIFE);" + vbCrLf + _

        "function setBar(x) {" + vbCrLf + _

        "bar.style.width = (100 * (x + 1) / n).toFixed() + '%';" + vbCrLf + _

        "bartext.innerText = (x + 1) + ' of ' + n;};" + vbCrLf + _

        "function setClock() { clock.innerText = new Date().toLocaleString('fa', timeOptions) };" + vbCrLf + _

        "</script>"



Public Const HTML_Start = _

        "<!DOCTYPE html>" + vbCrLf + _

        "<!-- saved from url=(0016)http://localhost -->" + vbCrLf + _

        "<html lang='en'>" + vbCrLf + _

        "<head>" + vbCrLf + _

        "<title title='Data-Paging with visual effects'></title>" + vbCrLf + _

        "<meta http-equiv='X-UA-Compatible' content='IE=edge' />" + vbCrLf + _

        "<meta charset='utf-8' />" + vbCrLf + _

        "<meta name='viewport' content='width=device-width, initial-scale=1'>" + vbCrLf + _

        "<link rel='stylesheet' href='../css/styles.css' type='text/css'>" + vbCrLf + _

        "<link rel='stylesheet' href='../css/themes.css' type='text/css'>" + vbCrLf + _

        "</head>" + vbCrLf + _

        "<body>" + vbCrLf + _

        "<div id='progress'>" + vbCrLf + _

        "<div id='bar-box'>" + vbCrLf + _

        "<span id='bar-text'></span>" + vbCrLf + _

        "<div id='bar'></div>" + vbCrLf + _

        "</div>" + vbCrLf + _

        "</div>" + vbCrLf + _

        "<div id='data'>" + vbCrLf



Public Const HTML_End = _

        "</div>" + vbCrLf + _

        "<div id='clock'></div>" + vbCrLf + _

        Script + vbCrLf + _

        "</body>" + vbCrLf + _

        "</html>"

themes.css

table.green, table.blue, table.orange, table.black {

    font-family: Tahoma;

    font-size: small;

    text-align: center;

    border-collapse: collapse;

    width: 100%;

    height: 100%;

    background-color: ghostwhite;

}





table.green {

    border: 2px solid darkgreen;

}





table.blue {

    border: 2px solid darkblue;

}





table.orange {

    border: 2px solid darkorange;

}





table.black {

    border: 2px solid black;

}





table.green thead {

    background-color: green;

    box-shadow: inset 1px 6px 12px lightgreen, inset -1px -10px 5px darkgreen, 1px 2px 1px black;

}





table.blue thead {

    background-color: blue;

    box-shadow: inset 1px 6px 12px lightblue, inset -1px -10px 5px darkblue, 1px 2px 1px black;

}





table.orange thead {

    background-color: darkorange;

    box-shadow: inset 1px 6px 12px orange, inset -1px -10px 5px red, 1px 2px 1px black;

}





table.black thead {

    background-color: black;

    box-shadow: inset 1px 3px 3px darkgray, inset -1px -3px 3px darkgray, 1px 2px 1px black;

}





    table.green thead th, table.blue thead th, table.orange thead th, table.black thead th {

        color: white;

        text-align: center;

    }





table.green td, table.green th {

    border: 1px solid darkgreen;

    padding: 3px 2px;

}





table.blue td, table.blue th {

    border: 1px solid darkblue;

    padding: 3px 2px;

}





table.orange td, table.orange th {

    border: 1px solid darkorange;

    padding: 3px 2px;

}





table.black td, table.black th {

    border: 1px solid black;

    padding: 3px 2px;

}





table.green td, table.blue td, table.orange td, table.black td {

}





table.green tbody td {

    color: darkgreen;

}





table.blue tbody td {

    color: darkblue;

}





table.orange tbody td {

    color: maroon;

}





table.black tbody td {

    color: black;

}





table.green tr:nth-child(even) {

    background-color: #CEE0CC;

}





table.blue tr:nth-child(even) {

    background: #95BCE0;

}





table.orange tr:nth-child(even) {

    background: #F5D08C;

}





table.black tr:nth-child(even) {

    background: #D0D0D0;

}

styles.css

html {

    width: 100%;

    height: 100%;

    overflow: clip;

}





body {

    background: linear-gradient(#EEEEEE,#6a6552);

}





#progress {

    position: relative;

    margin-left: 5%;

    margin-right: 5%;

    width: 90%;

}





#bar-box {

    width: 100%;

    padding: 4px;

    background: rgba(0, 0, 0, 0.25);

    border-radius: 6px;

    box-shadow: inset 0 1px 2px rgba(0, 0, 0, 0.25), 0 1px rgba(255, 255, 255, 0.08);

}





#bar {

    height: 20px;

    border-radius: 4px;

    background-color: #252e43;

    background-image: linear-gradient(to right, rgba(255, 255, 255, 0.8), rgba(255, 255, 255, 0.35));

    transition: 1s linear;

    transition-property: width, background-color;

    box-shadow: 0 0 1px 1px rgba(0, 0, 0, 0.25), inset 0 1px rgba(255, 255, 255, 0.1);

}





#bar-text {

    position: absolute;

    width: 100%;

    text-align: center;

    font-family: Tahoma;

    color: aliceblue;

    text-shadow: 2px 2px 4px black;

}





#clock {

    position: fixed;

    bottom: 1%;

    right: 1%;

    direction: rtl;

    font-family: 'Courier New';

    font-size: large;

    font-weight: bold;

    padding: 4px;

    border-radius: 6px;

    color: gold;

    box-shadow: rgba(0, 0, 0, 0.25) 0px 14px 28px, rgba(0, 0, 0, 0.22) 0px 10px 10px;

}





#data {

    position: relative;

    margin-top: 1%;

    margin-left: 1%;

    margin-right: 1%;

    width: 98%;

    height: 90vh;

    overflow: hidden;

}





.page {

    transition: ease-in-out all 1s;

    position: absolute;

    width: 100%;

    display: table-row;

    box-shadow: rgba(0, 0, 0, 0.7) 0px 5px 15px;

}





.switch {

    position: relative;

    display: inline-block;

    width: 50px;

    height: 20px;

}





    .switch input {

        opacity: 0;

        width: 0;

        height: 0;

    }





.slider {

    position: absolute;

    top: 0;

    left: 0;

    right: 0;

    bottom: 0;

    background-color: red;

    border-radius: 20px;

}





    .slider:before {

        position: absolute;

        content: "";

        height: 14px;

        width: 14px;

        left: 3px;

        bottom: 3px;

        background-color: white;

        border-radius: 50%;

    }





input:checked + .slider {

    background-color: lightgreen;

}





    input:checked + .slider:before {

        transform: translateX(28px);

    }





.visible {

    opacity: 1;

}





.hidden {

    opacity: 0;

}





.Fade_in {

}





.Fade_out {

}





.SlideRight_in {

    right: 0px;

}





.SlideRight_out {

    right: 120%;

}





.SlideLeft_in {

    left: 0px;

}





.SlideLeft_out {

    left: 120%;

}





.SlideUp_in {

    margin-top: 0px;

}





.SlideUp_out {

    margin-top: 120%;

}





.SlideDown_in {

    margin-top: 0px;

}





.SlideDown_out {

    margin-top: -120%;

}





.Zoom_in {

    transform: scale(1);

}





.Zoom_out {

    transform: scale(.1);

}





.RotateX_in {

    transform: rotateX(0deg);

}





.RotateX_out {

    transform: rotateX(180deg);

}





.RotateY_in {

    transform: rotateY(0deg);

}





.RotateY_out {

    transform: rotateY(180deg);

}





.Rotate_in {

    transform: rotate(0deg);

}





.Rotate_out {

    transform: rotate(180deg);

}

برنامه نهایی:

خروجی برنامه یک فایل به نام pager.html است (در فولدر html) که میتونین مستقل از برنامه در هر مرورگری اون رو باز کنین.
یک خروجی نمونه برای تست در این فولدر هست که با هر بار اجرا برنامه با نتایج جدید جایگزین میشه.

و این که فایلهای فولدر css برای نمایش درست نتیجه ضروری هست!

نقل قول:

---

نوشته شده توسط mazoolagh

برنامه نهایی:

خروجی برنامه یک فایل به نام pager.html است (در فولدر html) که میتونین مستقل از برنامه در هر مرورگری اون رو باز کنین.
یک خروجی نمونه برای تست در این فولدر هست که با هر بار اجرا برنامه با نتایج جدید جایگزین میشه.

و این که فایلهای فولدر css برای نمایش درست نتیجه ضروری هست!

---

خیلی عالی و ستودنی، واقعا دستتون درد نکنه. :تشویق::تشویق::تشویق:

نقل قول:

---

خیلی عالی و ستودنی، واقعا دستتون درد نکنه

---

ممنون از لطف شما
لطفا با دقت و کامل همه جوانب رو چک و اگر اشکالی هست گوشزد کنین،
همچنین اگر پیشنهادی در جهت بهتر شدن اون هست خوشحال میشم مطرح یا اگر وقت و حوصله دارین آپگرید کنین.

نقل قول:

---

نوشته شده توسط mazoolagh

ممنون از لطف شما
لطفا با دقت و کامل همه جوانب رو چک و اگر اشکالی هست گوشزد کنین،
همچنین اگر پیشنهادی در جهت بهتر شدن اون هست خوشحال میشم مطرح یا اگر وقت و حوصله دارین آپگرید کنین.

---

سلام و عرض ادب
تنها موردی که در حال حاضر به ذهن من میرسه در خصوص پروگرس بار هست که بعد از پایان دور اول و در آغاز لوپ دوم به جای آغاز از صفر به عقب برمیگرده، ولی چون تسلط کافی بر کدهای جاوا اسکریپت ندارم نتونستم کد رو اصلاح کنم.

دست مریزاد استاد!
فقط اگه براتون امکان داره یک نمونه هم که دارای دیتای(جدول) HTML باشه و از تغییر تم و افکت های در نظر گرفته شده در فرم Main استفاده کرد قرار بدهید.
ممنون

نقل قول:

---

نوشته شده توسط amirzazadeh

سلام و عرض ادب
تنها موردی که در حال حاضر به ذهن من میرسه در خصوص پروگرس بار هست که بعد از پایان دور اول و در آغاز لوپ دوم به جای آغاز از صفر به عقب برمیگرده، ولی چون تسلط کافی بر کدهای جاوا اسکریپت ندارم نتونستم کد رو اصلاح کنم.

---

سلام دوباره
و تشکر بخاطر دقت نظر شما

این پروگروس بار منطق پشتش قدری با کارهای دیگه متفاوت هست:
در جاهای دیگه وقتی یه پروسه رو شروع میکنیم، مقدار بار رو 0 میگذاریم و با هر مرحله مقدار رو تغییر میدیم.
مثلا اگر کلا 5 مرحله باشه مقدار اولیه اش 0 هست، بعد به ترتیب %20 و %40 و ... تا %100 - و دیگه کار تموم و بار هم بسته میشه.

اما اینجا ما قبل از شروع همه کارها رو آماده کردیم و اگر کلا 5 صفحه داریم در شروع کار در صفحه 1 هستیم پس مقدار اولبه بار %20 هست و نه 0.
وقتی در صفحه آخر (5) هستیم و مقدار بار هم %100 هست، مرحله بعدی ما دوباره صفحه 1 یا همون %20 میشه و هیچوقت 0 نداریم.

نقل قول:

---

نوشته شده توسط amirzazadeh

سلام و عرض ادب
تنها موردی که در حال حاضر به ذهن من میرسه در خصوص پروگرس بار هست که بعد از پایان دور اول و در آغاز لوپ دوم به جای آغاز از صفر به عقب برمیگرده، ولی چون تسلط کافی بر کدهای جاوا اسکریپت ندارم نتونستم کد رو اصلاح کنم.

---

در مورد این که چرا به عقب برمیگرده:
اگر افکت برای پروگروس بار تعریف نکرده باشیم، این حرکت رو به عقب دیده نمیشه و فقط مقدار بار درجا از %100 به مثلا %20 تغییر میکنه.
ولی اینجا یک transition برای بار تعریف شده (برای زیبایی) و این گذر روی سایز بار هم فعال هست برای همین حرکت رو به عقب دیده میشه،
البته معنی دار هم هست چون واقعا دوباره لوپ ریست میشه.

ولی میشه:
1- نمایش پروگروس رو بار رو با یک checkbox در فرم main بعنوان یک Option در اختیار کاربر قرار داد
2- داشتن transition رو برای پروگرس بار با یک چک باکس دیگه مشخص کرد

اگر اینها مفید هست لطفا اطلاع بدین تا پیاده کنم.

نقل قول:

---

نوشته شده توسط eb_1345

دست مریزاد !
فقط اگه براتون امکان داره یک نمونه هم که دارای دیتای(جدول) HTML باشه و از تغییر تم و افکت های در نظر گرفته شده در فرم Main استفاده کرد قرار بدهید.
ممنون

---

سلام دوباره
حتما

من برای تست همه حالت ها یک جدول لینک شده HTML هم داشتم (Customers_HTML)
که در پست شماره 116 هم در تصویر دیده میشه.

اون جدول رو همینجا پیوست میکنم،
چند رکورد اولش اینجوری هست:

<HTML>

<HEAD>

<TITLE>Customers</TITLE>

</HEAD>

<BODY>

<TABLE>

<CAPTION>Customers</CAPTION>

<TR>

<TD>ALFKI</TD>

<TD>Alfreds Futterkiste</TD>

<TD>Maria Anders</TD>

<TD>Sales Representative</TD>

<TD>Obere Str. 57</TD>

<TD>Berlin</TD>

<TD></TD>

<TD>12209</TD>

<TD>Germany</TD>

<TD>030-0074321</TD>

<TD>030-0076545</TD>

</TR>

<TR>

<TD>ANATR</TD>

<TD>Ana Trujillo Emparedados y helados</TD>

<TD>Ana Trujillo</TD>

<TD>Owner</TD>

<TD>Avda. de la Constituci&oacute;n 2222</TD>

<TD>México D.F.</TD>

<TD></TD>

<TD>05021</TD>

<TD>Mexico</TD>

<TD>(5) 555-4729</TD>

<TD>(5) 555-3745</TD>

</TR>

<TR>

<TD>ANTON</TD>

<TD>Antonio Moreno Taquer&iacute;a</TD>

<TD>Antonio Moreno</TD>

<TD>Owner</TD>

<TD>Mataderos  2312</TD>

<TD>México D.F.</TD>

<TD></TD>

<TD>05023</TD>

<TD>AROUT</TD>

<TD>Around the Horn</TD>

<TD>Thomas Hardy</TD>

<TD>Sales Representative</TD>

<TD>120 Hanover Sq.</TD>

<TD>London</TD>

<TD></TD>

<TD>WA1 1DP</TD>

<TD>UK</TD>

<TD>(171) 555-7788</TD>

<TD>(171) 555-6750</TD>

</TR>

</TABLE>

</BODY>

</HTML>

امیدوارم درست گرفته باشم منظور شما رو.

نقل قول:

---

نوشته شده توسط mazoolagh

سلام دوباره
و تشکر بخاطر دقت نظر شما

این پروگروس بار منطق پشتش قدری با کارهای دیگه متفاوت هست:
در جاهای دیگه وقتی یه پروسه رو شروع میکنیم، مقدار بار رو 0 میگذاریم و با هر مرحله مقدار رو تغییر میدیم.
مثلا اگر کلا 5 مرحله باشه مقدار اولیه اش 0 هست، بعد به ترتیب %20 و %40 و ... تا %100 - و دیگه کار تموم و بار هم بسته میشه.

اما اینجا ما قبل از شروع همه کارها رو آماده کردیم و اگر کلا 5 صفحه داریم در شروع کار در صفحه 1 هستیم پس مقدار اولبه بار %20 هست و نه 0.
وقتی در صفحه آخر (5) هستیم و مقدار بار هم %100 هست، مرحله بعدی ما دوباره صفحه 1 یا همون %20 میشه و هیچوقت 0 نداریم.

---

سلام و وقت به خیر، ممنون به خاطر توضیحات کامل وجامع.

نقل قول:

---

نوشته شده توسط mazoolagh

من برای تست همه حالت ها یک جدول لینک شده HTML هم داشتم (Customers_HTML)
که در پست شماره 116 هم در تصویر دیده میشه.

اون جدول رو همینجا پیوست میکنم،
چند رکورد اولش اینجوری هست:

---

بسیار عالی :تشویق::تشویق::تشویق:

نقل قول:

---

نوشته شده توسط mazoolagh

در مورد ساعت:
اگر هدف نمایش وقت هست که خود taskbar ساعت داره و نیازی نیست و کار بیهوده ای هست،
اگر هدف زیبایی فرم و ... هست که باز هم کار عبثی است!
اما اگر هدف چالش کدنویسی و محک زدن توانایی و ... است نتیجه اش همین هست که کار بیهوده ایست و بهتره وقتمون رو روی موارد مهمتر بگذاریم.

به هر حال چند راه وجود داره:
1- ساعت flash - که بهتره از اون اجتناب بشه، ولی ده ها طرح دیجیتال و آنالوگ ازش به راحتی در دسترس هست.
2- استفاده از فونت مناسب (بهترین روش)
3- استفاده از html5 در کنترل web browser
اون ساعت که نمونه اش رو فرستاده بودم در اصل یک فایل html بود که همینجا پیوست میکنم




[/CODE]

---

با سلام
چطوری کانکت میشه به وب بروزر با این کدها نشد یه نوتیفیکیشن زرد رنگ ریسک میده بعد از اجازه دوباره پی ام میده که canvce ساپورت نمیشه

Path = CurrentProject.Path & "\html\clock.html"

Forms!frmMain!wbroclock.Navigate (Path)

نقل قول:

---

نوشته شده توسط moustafa

با سلام
چطوری کانکت میشه به وب بروزر با این کدها نشد یه نوتیفیکیشن زرد رنگ ریسک میده بعد از اجازه دوباره پی ام میده که canvce ساپورت نمیشه

Path = CurrentProject.Path & "\html\clock.html"

Forms!frmMain!wbroclock.Navigate (Path)

---

سلام و روز خوش
1- درست در اول فایل html و قبل از هر چیزی (یعنی قبل از تگ <html>) این کد رو بگذارین:

<!DOCTYPE html>

<!-- saved from url=(0016)http://localhost -->

به طور ساده و خلاصه: کد خط دوم به مرورگر IE میفهمونه که داکیومنت شما trusted هست - دقت کنین که کنترل web browser بر اساس IE7 بنا شده!
در نتیجه نوار زرد رنگ رو دیگه نباید ببینین.

2- در بخش head فایل html اینها رو اضافه کنین:

<meta http-equiv='X-UA-Compatible' content='IE=edge' />

<meta charset='utf-8' />

<meta name='viewport' content='width=device-width, initial-scale=1'>

به طور ساده و خلاصه: کد خط اول برای رندر (render) شدن درست کدهای html/css هست که IE7 پشتیبانی نمیکنه،
به این صورت که وب بروزر رو هدایت میکنه که از انجین (engine) مرورگر مدرن edge استفاده کنه (کرومیوم).

==========

برای نمونه:
میتونین فایل pager.html برنامه پیوست مبحث "صفحه بندی دیتا با افکت و انیمیشن در مرورگر وب Data-paging with transitions/animations in We" رو بررسی کنین،
یا
در پست شماره 123 به تعریف html_start دقت کنین.

نقل قول:

---

نوشته شده توسط mazoolagh

سلام و روز خوش
1- درست در اول فایل html و قبل از هر چیزی (یعنی قبل از تگ <html>) این کد رو بگذارین:

<!DOCTYPE html>

<!-- saved from url=(0016)http://localhost -->

به طور ساده و خلاصه: کد خط دوم به مرورگر IE میفهمونه که داکیومنت شما trusted هست - دقت کنین که کنترل web browser بر اساس IE7 بنا شده!
در نتیجه نوار زرد رنگ رو دیگه نباید ببینین.

2- در بخش head فایل html اینها رو اضافه کنین:

<meta http-equiv='X-UA-Compatible' content='IE=edge' />

<meta charset='utf-8' />

<meta name='viewport' content='width=device-width, initial-scale=1'>

به طور ساده و خلاصه: کد خط اول برای رندر (render) شدن درست کدهای html/css هست که IE7 پشتیبانی نمیکنه،
به این صورت که وب بروزر رو هدایت میکنه که از انجین (engine) مرورگر مدرن edge استفاده کنه (کرومیوم).

==========

برای نمونه:
میتونین فایل pager.html برنامه پیوست مبحث "صفحه بندی دیتا با افکت و انیمیشن در مرورگر وب Data-paging with transitions/animations in We" رو بررسی کنین،
یا
در پست شماره 123 به تعریف html_start دقت کنین.

---

دست شما درد نکنه از این همه حوصله ومرام :تشویق::تشویق:واگه بخوایم فیت WebBrowser بشه چطور ؟ میشه ازش ایده گرفت برای گزارش سازی کدهای css و html5و js با کدهای vbaدست کاری بشن

نقل قول:

---

نوشته شده توسط moustafa

دست شما درد نکنه از این همه حوصله ومرام

---

ممنون از لطف شما

نقل قول:

---

واگه بخوایم فیت WebBrowser بشه چطور ؟

---

در html چند راه برای تعیین اندازه ها داریم:

1. اندازه گیری مطلق مانند پیکسل px ، سانتیمتر cm ، میلیمتر mm ، ...
2. اندازه گیری نسبی که براساس درسد % بیان میشه و میتونه نسبت به ابعاد المان parent ، المان root ، اندازه فونت، ابعاد viewport و ... باشه.

در همین فایل pager.html اگر دقت کنین یک کانتینر اصلی داریم که id اون data هست و همه المانها درون اون هستن

<div id='data'>

داخل data تعدادی کانتینر دیگه داریم (هر کدام برای یک page از pager) که پشت سر هم چیده شدن
ولی هر بار فقط یکی نشون داده میشه - به جز زمان عوض شدن صفحه و اجرای افکت ها
و داخل هر کدون از این کانتینرها یک جدول table برای نمایش دیتا هر page داریم که تم اون رو با یک کلاس class تعریف کردیم

<div id='page_1' class='page visible Fade_in'>

    <table class='black'>

    ...

    </table>

</div>

<div id='page_2' class='page hidden Fade_out'>

    <table class='blue'>

    ...

    </table>

</div>

حالا برای دیدن چگونگی تعیین اندازه ها در فایل styles.css دقت کنین:

#data {

    position: relative;

    margin-top: 1%;

    margin-left: 1%;

    margin-right: 1%;

    width: 98%;

    height:90vh;

    overflow:hidden;

}

یعنی که پهنای اون 98% برابر پهنای parent element (که میشه body) هست،
و 1% از چپ و راست margin داره (که میشه وسط-چین)،
و 1% از بالا margin داره که چون موقعیتش نسبی تعریف شده (position:relative) یعنی 1% از المان خواهرش (قبلی که میشه کانتینر progress)
و قدش هم 90% قد viewport هست.

یعنی وقتی شما اندازه مرورگر رو تغییر میدین،
پهنای کانتینر data همیشه به صورت خودکار 98% پهنای body
و قدش همیشه 90% قد viewport تنظیم میشه.

و برای هر page :

.page {

    transition: ease-in-out all 1s;

    position: absolute;

    width: 100%;

    display: table-row;

    box-shadow: rgba(0, 0, 0, 0.7) 0px 5px 15px;

}

پهنای اون همیشه 100% پهنای data هست

و برای هر table

table.green, table.blue, table.orange, table.black {

    font-family: Tahoma;

    font-size:small;

    text-align: center;

    border-collapse: collapse;

    width: 100%;

    height: 100%;

    background-color: ghostwhite;

}

همیشه اندازه اش به صورت خودکار تمام فضای در دسترس page رو پر میکنه (100%)


یا در مورد کانتینر clock که همیشه گوشه پایین دست راست قرار میگیره:

#clock {

    position: fixed;

    bottom: 1%;

    right: 1%;

    direction: rtl;

    font-family: 'Courier New';

    font-size: large;

    font-weight: bold;

    padding: 4px;

    border-radius: 6px;

    color: gold;

    box-shadow: rgba(0, 0, 0, 0.25) 0px 14px 28px, rgba(0, 0, 0, 0.22) 0px 10px 10px;

}

با تعیین right و bottom به اندازه 1% از body انجام میشه،
و چون position اون fixed هست اگر قد مرورگر کافی نباشه میفته روی بخش های دیگه

نقل قول:

---

میشه ازش ایده گرفت برای گزارش سازی کدهای css و html5و js با کدهای vbaدست کاری بشن

---

دقیقا هدف از این گفتگو هم همین بوده.
شما میتونین هر گزارشی رو که در اکسس ساختنش نشدنی هست رو با این روش بسازین.

در واقع کارهای بیشتری هم میتونین انجام بدین.
اینگونه نیست که فقط برای خروجی (گزارش سازی) استفاده بشه،
میتونین با کنترل مرورگر تعامل دو طرفه داشته باشین و فرم هم بسازین.

این فرم میتونه یک فرم unbound باشه مثل فرم login یا data entry ،
و با صرف وقت و حوصله و کدنویسی حتی میشه از نظر کار مثل فرم Bound باشه.

آموزش ساخت فرم unbound با کنترل وب بروزر و نحوه کار با رخدادهای این کنترل رو در برنامه دارم.

نقل قول:

---

نوشته شده توسط mazoolagh

دقیقا هدف از این گفتگو هم همین بوده.
شما میتونین هر گزارشی رو که در اکسس ساختنش نشدنی هست رو با این روش بسازین.

در واقع کارهای بیشتری هم میتونین انجام بدین.
اینگونه نیست که فقط برای خروجی (گزارش سازی) استفاده بشه،
میتونین با کنترل مرورگر تعامل دو طرفه داشته باشین و فرم هم بسازین.

این فرم میتونه یک فرم unbound باشه مثل فرم login یا data entry ،
و با صرف وقت و حوصله و کدنویسی حتی میشه از نظر کار مثل فرم Bound باشه.

آموزش ساخت فرم unbound با کنترل وب بروزر و نحوه کار با رخدادهای این کنترل رو در برنامه دارم.

---

با سلام و عرض ادب، بی صبرانه منتظر پست های بعدی این تاپیک هستم.

نقل قول:

---

نوشته شده توسط mazoolagh

ممنون از لطف شما



دقیقا هدف از این گفتگو هم همین بوده.
شما میتونین هر گزارشی رو که در اکسس ساختنش نشدنی هست رو با این روش بسازین.

در واقع کارهای بیشتری هم میتونین انجام بدین.
اینگونه نیست که فقط برای خروجی (گزارش سازی) استفاده بشه،
میتونین با کنترل مرورگر تعامل دو طرفه داشته باشین و فرم هم بسازین.

این فرم میتونه یک فرم unbound باشه مثل فرم login یا data entry ،
و با صرف وقت و حوصله و کدنویسی حتی میشه از نظر کار مثل فرم Bound باشه.

آموزش ساخت فرم unbound با کنترل وب بروزر و نحوه کار با رخدادهای این کنترل رو در برنامه دارم.

---

بسیار سپاسگذارم . فقط کنجکاو شدم با اینهمه مهارت و زحمات چرا تو اکسس و الکترون جی اس نه ؟ وقتی اینهمه مهارت در این سه مورد داشته باشین با ری اکت نیتیو می تونید برنامه موبایل بسازین با نود جی اس یک اند سایت و در یونیتی گیم و ... خیلی کارای دیگه .من خیلی وقتیه که فکرمیکردم اکسس تموم شده است علی الخصوص که الان همچی وب بیس محور شده

نقل قول:

---

نوشته شده توسط moustafa

بسیار سپاسگذارم . فقط کنجکاو شدم با اینهمه مهارت و زحمات چرا تو اکسس و الکترون جی اس نه ؟ وقتی اینهمه مهارت در این سه مورد داشته باشین با ری اکت نیتیو می تونید برنامه موبایل بسازین با نود جی اس یک اند سایت و در یونیتی گیم و ... خیلی کارای دیگه .من خیلی وقتیه که فکرمیکردم اکسس تموم شده است علی الخصوص که الان همچی وب بیس محور شده

---

هر چیزی جایگاه خودش رو داره،
اکسس هم مثل اپلیکیشن های دیگه آفیس هیچ رقیب و مشابهی نداره،
و با این اندازه برنامه در حال کار به این زودی ها کنار گذاشته نمیشه.
حتی سی سال هم پیش که اکسس تازه آمده بود و چند رقیب جدی جا افتاده داشت کنار نرفت - الان که دیگه هیچ جایگزینی براش نیست.

ولی چون اکسس یک ابزار هست - و برای حل یک مسئله ممکنه ابزارهای مختلفی بشه استفاده کرد - باید ببینیم در یک مسئله بخصوص اکسس ابزار مناسبی هست یا نه.

چالش امروز واقعا خارج از دستور هست،
فرض کنید شکل هندسی زیر رو داریم و نیاز هست که:
1- مساحت
2- پیرامون
3- گرانیگاه (یا مرکز جرم)
اونها رو بدست بیاریم (همه اندازه ها به سانتیمتر).

ضمیمه 155774

توضیح این که دایره و مربع درون شکل سوراخ هستن.

گرچه این شکل محاسبات نسبتا ساده ای داره و میشه خواسته ها رو با فرمول های معمولی بدست آورد،
ولی موضوع این هست که در حل این مسئله هیچ دانش هندسه نداریم،
یعنی قرار نیست اندازه ها رو فرموله کنیم و برنامه ای برای محاسبه خواسته ها بنویسیم.
قرار هست یک راه بهتر پیدا کنیم که این محاسبات رو برای ما انجام بده.

برای درک بهتر این که چرا قرار نیست هندسه مسئله رو خودمون حل کنیم،
فرض کنید همین خواسته برای شکل زیر بود (البته اینجا نیست - مگر کسی که علاقه داشته باشه):

ضمیمه 155775

تنها محدودیتی که داریم این هست که باید از vba و از اکسس (یا اکسل) استفاده کنیم.

و مهم این که اشاره به روش کافی نیست!
کدهای کامل حل مسئله و توضیح کارها هم نیاز هست.

راهنمایی:
باید autocad روی سیستم نصب شده باشه!