محمد طاهر عرفه قام بنشر أبريل 19, 2009 مشاركة قام بنشر أبريل 19, 2009 هذا الموضوع أتصور أنه سبق طرحه ،و لكن بحثت عنه و لم أجده لذا سأضيفه ثانية حيث احتجته مؤخرا و لم أجده الفكرة هي الرغبة فى استخراج أسماء الجداول و الحقول الى ملف اكسيل و ذلك بغرض استخدامها فى توثيق معلومات قاعدة البيانات ضع موديول (وحدة نمطية) جديدة فى القاعدة ، ثم انسخ الكود التالي اليها ثم شغله باستخدام F5 و لا اعتقد انه من المفيد وضع زر لتشغيله حيث عادة ما تحتاج لاجراء هذه العملية مرة واحدة او مرات قليلة لكل قاعدة تقوم بتصميمها ، اذا ما ما كنت ستقوم بتوثيقها أو كتابة تقرير عنها و ستكون النتيجة تكوين ملف اكسيل يحوي أربعة أعمدة الاول يحوي اسم الجدول و الثاني يحوي اسماء الحقول و الثالث يحوي على نوع الحقل ، و الأخير يدل على سعة الحقل و لا تنسي توسيع اول عمودان فى الاكسيل بعد أن ينفتح الملف منقول بتصرف و اضافة Option Compare Database Option Explicit Sub ListTablesAndFields() 'Macro Purpose: Write all table and field names to and Excel file Dim lTbl As Long Dim lFld As Long Dim dBase As Database Dim xlApp As Object Dim wbExcel As Object Dim lRow As Long 'Set current database to a variable adn create a new Excel instance Set dBase = CurrentDb Set xlApp = CreateObject("Excel.Application") Set wbExcel = xlApp.workbooks.Add 'Set on error in case there is no tables On Error Resume Next 'Loop through all tables For lTbl = 0 To dBase.TableDefs.Count - 1 'If the table name is a temporary or system table then ignore it If Left(dBase.TableDefs(lTbl).Name, 1) = "~" Or _ Left(dBase.TableDefs(lTbl).Name, 4) = "MSYS" Then '~ indicates a temporary table 'MSYS indicates a system level table Else 'Otherwise, loop through each table, writing the table and field names 'to the Excel file For lFld = 0 To dBase.TableDefs(lTbl).Fields.Count - 1 lRow = lRow + 1 With wbExcel.sheets(1) .range("A" & lRow) = dBase.TableDefs(lTbl).Name .range("B" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Name .range("C" & lRow) = FieldType(dBase.TableDefs(lTbl).Fields(lFld).Type) .range("D" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Size End With Next lFld End If Next lTbl 'Resume error breaks On Error GoTo 0 'Set Excel to visible and release it from memory xlApp.Visible = True Set xlApp = Nothing Set wbExcel = Nothing 'Release database object from memory Set dBase = Nothing End Sub Function FieldType(intType As Integer) As String Select Case intType Case dbBoolean FieldType = "dbBoolean" Case dbByte FieldType = "dbByte" Case dbInteger FieldType = "dbInteger" Case dbLong FieldType = "dbLong" Case dbCurrency FieldType = "dbCurrency" Case dbSingle FieldType = "dbSingle" Case dbDouble FieldType = "dbDouble" Case dbDate FieldType = "dbDate" Case dbText FieldType = "dbText" Case dbLongBinary FieldType = "dbLongBinary" Case dbMemo FieldType = "dbMemo" Case dbGUID FieldType = "dbGUID" End Select 1 رابط هذا التعليق شارك More sharing options...
ابو ياسر قام بنشر أبريل 20, 2009 مشاركة قام بنشر أبريل 20, 2009 (معدل) ]أصالة عن نفسي ونيابة عن كل مرتادي هذا المنتدى أتقدم بالشكر الوافر الجزيل وبالامتنان والعرفان للقائم على هذا المنتدى الرجل الفاضل الشهم الكريم محمد طاهر أسعد الله أيامك ولياليك وأصلح لك ذريتك ، وأجزل لك الثواب ، وجعل ما تقوم به في ميزان حسناتك تم تعديل أبريل 20, 2009 بواسطه sabha 2 رابط هذا التعليق شارك More sharing options...
rudwan قام بنشر أبريل 21, 2009 مشاركة قام بنشر أبريل 21, 2009 بارك الله فيك استاذنا محمد رابط هذا التعليق شارك More sharing options...
Mohamed Nada قام بنشر مايو 2, 2009 مشاركة قام بنشر مايو 2, 2009 (معدل) بارك الله فيك أستاذنا محمد طاهر... أتعرف لقد خطرت هذه الفكرة على بالى مرات عديدة .. ولكننى تخيلت أن هذا غير ممكن .. فأصرف نظر عنه. الله ينور عليك دايماً تطلع فى الوقت المناسب بحلول رائعة. تحياتى لشخصك الكريم محمد ندا تم تعديل مايو 2, 2009 بواسطه Mohamed Nada رابط هذا التعليق شارك More sharing options...
ابو يامن قام بنشر أغسطس 19, 2009 مشاركة قام بنشر أغسطس 19, 2009 مشكور أخي محمد على هذه الإضافة الرائعة بالفعل شيء جميل بارك الله فيك و جعله الله في ميزان حسناتك رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان