محمد طاهر عرفه

هذا كود بسيط لتوزيع القيمة أفقيا علي مجموعة من الخلايا بالتساوي اكتب رقم فى أي خلية شغل الماكرو سيسأل عن عدد الخلايا المطلوب التوزيع عليها نفذ مفيد لمن يقومون بالتدفقات النقدية المتساوية مع تحياتي DistributeEqual.rar

فهرس سلسلة دروس الأخ أحمد الحربي 1- تعريف بـ adp http://www.officena.net/ib/index.php?showtopic=1244 2- تنصيب MSDE http://www.officena.net/ib/index.php?showtopic=1246 3- MSDE من الداخل http://www.officena.net/ib/index.php?showtopic=1249 4- إنشاء قاعدة على الملقم MSDE http://www.officena.net/ib/index.php?showtopic=1251 5- الجداول في مشاريع أكسس http://www.officena.net/ib/index.php?showtopic=1269

أخي فهد ظننت انها بالعربي :d Format = تنسيق Control Box = صندوق تحكم ( علي ما اعتقد ) مع تحياتي

هناك بعض الخواص من خواص النماذج لا يمكن التحكم يها فى وضع العرض مثل اخفاء و اظهار صندوق التحكم فلا يمكنك تشغيل الكود التالي me.controlbox = false فى وضع العرض و لكن لابد ان تفتح النموذج فى وضع التصميم و تغير الخاصية ، ثم تفتحه فى وضع العرض ايضا المثال به تطبيق لاستخدام الدالة isloaded لمنع فتح نموذج رقم 2 دون وجود نموذج رقم 1 مفتوحا DesignViewChanges.rar

يمكنك استنتاج القرص مباشرة اكواد للتعامل مع الملفات و المجلدات http://www.officena.net/ib/index.php?showtopic=1318

و مرفق المثال لعمل كشف حساب عميل للاخ أمير customer_mobtadii.rar

يعني المثال طلع بتاع الاخ امير :( مشرفنا العزيز ما في المثال هو تثبيت للشاشة Freeze panes و ليس الغاء للاعمدة جرب التحرك بالاسهم ستجد الخلايا موجودة و لكنها لا تظهر لايقاف التثبيت Window unfreeze panes

شكرا لك و كل طرح جديد ان شاء الله يكون فيه فائدة مواضيع مرتبطة التحويل بين التاريخ الهجري و الميلادي http://www.officena.net/ib/index.php?showt...=1020&hl=الهجرى تقويم أم القري و التقويم الهجري http://www.officena.net/ib/index.php?showt...557&hl=أم+القرى نموذج التقويم ( النتيجة ) نموذج لاختيار التاريخ من نتيجة http://www.officena.net/ib/index.php?showt...726&hl=أم+القرى أداة لإدخال تاريخ أم القرى ActiveX control http://www.officena.net/ib/index.php?showt...295&hl=أم+القرى

لا تظهر لدي رسالة الخطأ جرب ازالة المسافات او كتابة الحقل بالانجليزية فى كلمة واحدة newdate: DateAdd("m";[b];[a]) و عموما جرب الدالة nz newdate: nz(DateAdd("m";[b];[a]))

أخي فهد أنا أيضا أوؤيد كلام الاخ أمير من حيث المبدأ ، وأراه الحل الامثل لمثل هذه البرامج بصفة عامة و هذا الجدول يناظرجدول الحركات الذي وصفته فى ردي السابق مع تحياتي

لكن اعتقد أن التغييير بالكود فى وضع عرض النموذج قد لا ينجح لذا قد يكون الحل هو : - فتح النموذج بالكود فى وضع التصميم acdesign -اجراء التعديل -حفظ النموذج و اغلاقه - اعادة الفتح فى وضع العرض

هل ورقة العمل محمية ؟؟ ضع رابط الملف الذي حملته

من خصائص النموذج تبويب Format Control Box no

اضغط ctr+A ثم Format Column unhide

و هذا كود آخر ( من موقع أجنبي ) Declarations: Private Declare Function SHFormatDrive Lib "shell32" _ (ByVal hWnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal Options As Long) As Long Private Declare Function GetDriveType Lib "kernel32" Alias _ "GetDriveTypeA" (ByVal nDrive As String) As Long Private Const FORMAT_FULL = &H1 Code: Public Function FormatDrive(ByVal DriveLetter As String, _ Optional PermitNonRemovableFormat As Boolean = False) As _ Boolean '************************************************** 'Formats a drive specified by Drive Letter. 'Confirmation box will appear 'Set PermitNonRemovableFormat to true if you want to allow for _ formating of fixed drive or other non-removable drive (e.g., C:\) 'Returns true if successful, false otherwise 'EXAMPLE 1: FormatDrive "A:\" 'formats drive A: 'EXAMPLE 2: FormatDrive "C:\" 'Will fail because PermitNonRemovableFormat is not set 'to true 'I have not tested formatting fixed drives because there 'are no fixed drives I want to format 'USE WITH CAUTION: IF YOU DON'T FOLLOW INSTRUCTIONS 'YOU CAN WIPE OUT SOMEONE'S HARD DRIVE '************************************************** Dim sDrive As String Dim lDrive As Long Dim iDriveType As Integer Dim iAns As Integer Dim sDriveLetter Dim lRet As Long sDrive = UCase(DriveLetter) sDriveLetter = sDrive 'format as [Letter]:/ if not done already If Len(sDrive) = 1 Then sDriveLetter = sDriveLetter & ":\" If Len(sDrive) = 2 And Right$(sDrive, 1) = ":" _ Then sDriveLetter = sDrive & "\" lDrive = Asc(Left(sDrive, 1)) - 65 iDriveType = DriveType(sDrive) Select Case iDriveType Case 2 lRet = SHFormatDrive(Me.hWnd, lDrive, HFFFF, FORMAT_FULL) FormatDrive = lRet = 0 Case 3, 4, 5, 6 If Not PermitNonRemovableFormat Then Exit Function lRet = SHFormatDrive(Me.hWnd, lDrive, HFFFF, FORMAT_FULL) FormatDrive = lRet = 0 Case Else 'no such drive Exit Function End Select End Function Private Function DriveType(Drive As String) As Integer Dim sAns As String, lAns As Long 'fix bad parameter values If Len(Drive) = 1 Then Drive = Drive & ":\" If Len(Drive) = 2 And Right$(Drive, 1) = ":" _ Then Drive = Drive & "\" DriveType = GetDriveType(Drive) End Function

من الممكن وضع ملف باي اسم علي محرك الاقراص و البحث عن الملف علي السي دي قبل فتح البرنامج ، و اغلاق البرنامج اذا لم يوجد و قد يمكن حساب بيان ما عن القرض مثل اسمه ، و سعته و المساحة الخالية و لكن فى النهاية كل هذا سيمكن التغلب عليه بعمل نسخة للاسطوانة نفسها و لحماية الاسطوانة من النسخ توجد تقنيات لذلك مثل ال Laser Lock و لكنها تتم فى تصنيع الاسطوانة نفسها و للمزيد عن هذه التقنيات يمكنك مراجعة اقسام الدعم الفني فى المنتديات المتخصصة

http://www.mvps.org/access/downloads/justidirect.zip http://www.mvps.org/access/downloads/justification.zip ويمكن التعامل من خلال علاقة الاكسيس بالوورد كحل بديل فتح ملف معين(word)عن طريق الاكسيس مع التصدير اليه http://www.officena.net/ib/index.php?showt...pic=659&hl=وورد الدمج البريدي بين الوورد و قواعد البيانات وورد مع : وورد ، أكسس ، إكسيل http://www.officena.net/ib/index.php?showtopic=148

يمكن الاخفاء و لا يمكن الالغاء علي حد ما أعرف

استكمالا للموضوع هذه بعض الاكواد الاخري لمعرفة المحركات الموجودة و انواعها Task: Get Drive Type using GetDriveType API Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Const DRIVE_UNKNOWN = 0 Private Const DRIVE_DOES_NOT_EXIST = 1 Private Const DRIVE_REMOVABLE = 2 Private Const DRIVE_FIXED = 3 Private Const DRIVE_REMOTE = 4 Private Const DRIVE_CDROM = 5 Private Const DRIVE_RAMDISK = 6 -------- Private Sub Form_Load() Select Case GetDriveType("C:\") Case DRIVE_UNKNOWN MsgBox "Unknown drive type", vbExclamation Case DRIVE_DOES_NOT_EXIST MsgBox "Drive doesn't exist", vbCritical Case DRIVE_REMOVABLE MsgBox "The disk can be removed from the drive", vbInformation Case DRIVE_FIXED MsgBox "The disk cannot be removed from the drive", vbInformation Case DRIVE_REMOTE MsgBox "The drive is a remote (network) drive", vbInformation Case DRIVE_CDROM MsgBox "The drive is a CD-ROM drive", vbInformation Case DRIVE_RAMDISK MsgBox "The drive is a RAM disk", vbInformation End Select End End Sub 'Visit my Homepage at 'http://www.geocities.com/marskarthik 'http://marskarthik.virtualave.net 'Email: marskarthik@angelfire.com و أيضا '************ Code Start ************** 'This code was originally written by Terry Kreft 'and Dev Ashish. 'It is not to be altered or distributed, 'except as part of an application. 'You are free to use it in any application, 'provided the copyright notice is left unchanged. ' ' Original Code by Terry Kreft ' Modified by Dev Ashish ' 'Drive Types Private Const DRIVE_UNKNOWN = 0 Private Const DRIVE_ABSENT = 1 Private Const DRIVE_REMOVABLE = 2 Private Const DRIVE_FIXED = 3 Private Const DRIVE_REMOTE = 4 Private Const DRIVE_CDROM = 5 Private Const DRIVE_RAMDISK = 6 ' returns errors for UNC Path Private Const ERROR_BAD_DEVICE = 1200& Private Const ERROR_CONNECTION_UNAVAIL = 1201& Private Const ERROR_EXTENDED_ERROR = 1208& Private Const ERROR_MORE_DATA = 234 Private Const ERROR_NOT_SUPPORTED = 50& Private Const ERROR_NO_NET_OR_BAD_PATH = 1203& Private Const ERROR_NO_NETWORK = 1222& Private Const ERROR_NOT_CONNECTED = 2250& Private Const NO_ERROR = 0 Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _ "WNetGetConnectionA" (ByVal lpszLocalName As String, _ ByVal lpszRemoteName As String, cbRemoteName As Long) As Long Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _ "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _ (ByVal nDrive As String) As Long Private Function fGetDrives() As String 'Returns all mapped drives Dim lngRet As Long Dim strDrives As String * 255 Dim lngTmp As Long lngTmp = Len(strDrives) lngRet = GetLogicalDriveStrings(lngTmp, strDrives) fGetDrives = Left(strDrives, lngRet) End Function Private Function fGetUNCPath(strDriveLetter As String) As String On Local Error GoTo fGetUNCPath_Err Dim Msg As String, lngReturn As Long Dim lpszLocalName As String Dim lpszRemoteName As String Dim cbRemoteName As Long lpszLocalName = strDriveLetter lpszRemoteName = String$(255, Chr$(32)) cbRemoteName = Len(lpszRemoteName) lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, _ cbRemoteName) Select Case lngReturn Case ERROR_BAD_DEVICE Msg = "Error: Bad Device" Case ERROR_CONNECTION_UNAVAIL Msg = "Error: Connection Un-Available" Case ERROR_EXTENDED_ERROR Msg = "Error: Extended Error" Case ERROR_MORE_DATA Msg = "Error: More Data" Case ERROR_NOT_SUPPORTED Msg = "Error: Feature not Supported" Case ERROR_NO_NET_OR_BAD_PATH Msg = "Error: No Network Available or Bad Path" Case ERROR_NO_NETWORK Msg = "Error: No Network Available" Case ERROR_NOT_CONNECTED Msg = "Error: Not Connected" Case NO_ERROR ' all is successful... End Select If Len(Msg) Then MsgBox Msg, vbInformation Else fGetUNCPath = Left$(lpszRemoteName, cbRemoteName) End If fGetUNCPath_End: Exit Function fGetUNCPath_Err: MsgBox Err.Description, vbInformation Resume fGetUNCPath_End End Function Private Function fDriveType(strDriveName As String) As String Dim lngRet As Long Dim strDrive As String lngRet = GetDriveType(strDriveName) Select Case lngRet Case DRIVE_UNKNOWN 'The drive type cannot be determined. strDrive = "Unknown Drive Type" Case DRIVE_ABSENT 'The root directory does not exist. strDrive = "Drive does not exist" Case DRIVE_REMOVABLE 'The drive can be removed from the drive. strDrive = "Removable Media" Case DRIVE_FIXED 'The disk cannot be removed from the drive. strDrive = "Fixed Drive" Case DRIVE_REMOTE 'The drive is a remote (network) drive. strDrive = "Network Drive" Case DRIVE_CDROM 'The drive is a CD-ROM drive. strDrive = "CD Rom" Case DRIVE_RAMDISK 'The drive is a RAM disk. strDrive = "Ram Disk" End Select fDriveType = strDrive End Function Sub sListAllDrives() Dim strAllDrives As String Dim strTmp As String strAllDrives = fGetDrives If strAllDrives <> "" Then Do strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1) strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1) Select Case fDriveType(strTmp) Case "Removable Media": Debug.Print "Removable drive : " & strTmp Case "CD ROM": Debug.Print " CD Rom drive : " & strTmp Case "Fixed Drive": Debug.Print " Local drive : " & strTmp Case "Network Drive": Debug.Print " Network drive : " & strTmp Debug.Print " UNC Path : " & _ fGetUNCPath(Left$(strTmp, Len(strTmp) - 1)) End Select Loop While strAllDrives <> "" End If End Sub '**************** Code End ****************** و مصدره http://www.mvps.org/access/api/api0003.htm للتعرف علي المجلد الذي به القاعدة Function GetPath(Name As String) As String Dim i As Integer, pathtemp As String i = 1 Do While i < Len(Name) pathtemp = "" Do While Mid(Name, i, 1) <> "\" And i <= Len(Name) pathtemp = pathtemp & Mid(Name, i, 1) i = i + 1 Loop If Mid(Name, i, 1) = "\" Then GetPath = GetPath & pathtemp & "\" i = i + 1 End If Loop End Function و لاستدعاؤه فى رسالة مثلا من الكود الخاص بالنقر علي زر : Private Sub Command3_Click() MsgBox GetPath(CurrentDb.Name) End Sub

هذه المجموعة من الاكواد من تجميع ابو حمود -------------------------------------------------- — للبحث عن ملف : Set fs = Application.FileSearch With fs .LookIn = "C:\My Documents" .FileName = "DO.*" If .Execute > 0 Then MsgBox "There were " & .FoundFiles.Count & _ " file(s) found." For I = 1 To .FoundFiles.Count MsgBox .FoundFiles(I) Next I Else MsgBox "There were no files found." End If End With ولإعادة البحث : With Application.FileSearch If .Execute() > 0 Then MsgBox "There were " & .FoundFiles.Count & _ " file(s) found." For i = 1 To .FoundFiles.Count MsgBox .FoundFiles(i) Next i Else MsgBox "There were no files found." End If End With ولإعادة البحث مع تحديد معيار أكثر تفصيلاً : With Application.FileSearch .NewSearch .LookIn = "C:\My Documents" .SearchSubFolders = True .FileName = "Run" .MatchTextExactly = True .FileType = msoFileTypeAllFiles End With انظر التفصيلات في هذا المثال : With Application.FileSearch .NewSearch .LookIn = "C:\My Documents" .SearchSubFolders = True .FileName = "run" .TextOrProperty = "San*" .MatchAllWordForms = True .FileType = msoFileTypeAllFiles If .Execute() > 0 Then MsgBox "There were " & .FoundFiles.Count & _ " file(s) found." For I = 1 To .FoundFiles.Count MsgBox .FoundFiles(i) Next I Else MsgBox "There were no files found." End If End With — لنسخ ملف إلى دليل آخر باستخدام الطريقة CopyFile Dim fs Set fs = CreateObject("Scripting.FileSystemObject") fs.CopyFile "C:\My Documents\شهادة.Gif", "c:\My Documents\My Pictures\", True True للكتابة فوق نسخة موجودة وFalse للنسخ بدون كتابة ، ويعطي رسالة خطأ إذا وجد نسخة . — لنسخ ملف باستخدام FileCopy Dim SourceFile, DestinationFile SourceFile = "اسم الملف مع القرص والدليل" DestinationFile = "اسم المحرك والمجلد" FileCopy SourceFile, DestinationFile — نسخ محتويات مجلد Folder إلى مجلد آخر باستخدام الطريقة CopyFolder Dim fs Set fs = CreateObject("Scripting.FileSystemObject") fs.CopyFolder "C:\My Documents\مجلد جديد" "c:\My Documents\برامج", True — لإنشاء مجلد جديد باستخدام الطريقة CreateFolder Dim fs Set fs = CreateObject("Scripting.FileSystemObject") fs.CreateFolder "C:\My Documents\مجلد جديد" ● لإنشاء مجلد folder استخدم : MkDir "اسم المجلد الجديد" لاحظ إذا لم يكتب اسم محرك الأقراص قبل المجلد فسوف ينشأ المجلد على محرك الأقراص الحالي . — لحذف ملف باستخدام الطريقة DeleteFile Set fs = CreateObject("Scripting.FileSystemObject") fs.DeleteFile "C:\My Documents\نسخ من شهادة.gif", True True لحذف ملف للقراء فقط وFalse لعدم حذفه . — لحذف مجلد باستخدام الطريقة DeleteFolder Dim fs Set fs = CreateObject("Scripting.FileSystemObject") fs.DeleteFolder "C:\My Documents\مجلد جديد", True True لحذف مجلد للقراء فقط وFalse لعدم حذفه ، لاحظ أنه يحذف المجلد وكل الملفات التي بداخله . — لحذف مجلد : Rmdir "اسم المجلد" لابد أن يكون هذا المجلد خالي من الملفات ليتم حذفه وإلا استخدم Kill لحذف الملفات أولا : Kill ("اسم القرص والدليل والملف مع اللاحقة") ولحدف كافة محتويات المجلد استخدم بعد القرص ثم المجلد : *.* ولحذف نوع ملفات استخدم النجمة واللاحقة مثال : *.TXT — لمعرفة أقراص المحركات الموجودة باستخدام الطريقة DriveExists Dim fs Set fs = CreateObject("Scripting.FileSystemObject") fs.DriveExists("c") يعيد السطر الأخير True إذا وجد المحرك وFalse إذا لم يجده ، لاحظ أن المحركات القابلة للإزالة يعيد السطر الأخير لها True ولو لم تكن موجودة . — لمعرفة الملفات الموجودة باستخدام الطريقة FileExists Dim fs Set fs = CreateObject("Scripting.FileSystemObject") MsgBox fs.FileExists("c:\my documents\شهادة.gif") يعيد السطر الأخير True إذا وجد الملف وFalse إذا لم يجده ، لاحظ أنه يجي عليك كتابة المجلد واسم الملف واللاحقة . — لمعرفة المجلدات الموجودة باستخدام الطريقة FolderExists Dim fs Set fs = CreateObject("Scripting.FileSystemObject") MsgBox fs.FolderExists ("c:\my documents") يعيد السطر الأخير True إذا وجد المجلد وFalse إذا لم يجده ، لاحظ أنه يجي عليك كتابة المحرك واسم المجلد . لمعرفة محركات الأقراص الموجودة في الحاسب : Sub ShowDriveList Dim fs, d, dc, s, n Set fs = CreateObject("Scripting.FileSystemObject") Set dc = fs.Drives For Each d in dc s = s & d.DriveLetter & " - " If d.DriveType = 3 Then n = d.ShareName Else n = d.VolumeName ' هذا السطر يظهر اسم محرك الأقراص قد يسبب مشاكل ويفضل تعطيله End If s = s & n & vbCrLf Next MsgBox s End Sub ● لإظهار المحركات في قائمة منسدلة ؛ ضع في حدث عند التركيز : Dim fs, d, dc Dim الكل As Variant Dim محركات_الأقراص As String Set fs = CreateObject("Scripting.FileSystemObject") Set dc = fs.Drives For Each d In dc محركات_الأقراص = d If IsEmpty(الكل) Then الكل = محركات_الأقراص & "\" Else الكل = الكل & ";" & محركات_الأقراص & "\" End If Next Me![اسم القائمة المنسدلة].RowSource = الكل ملاحظة هامة جداً : يجب جعل نوع مصدر الصف للقائمة هي قائمة القيم . — لإظهار الملفات في دليل Sub ShowFileList(folderspec) Dim fs, f, f1, fc, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(folderspec) Set fc = f.Files For Each f1 in fc s = s & f1.name s = s & vbCrLf Next MsgBox s End Sub ويستدعى من إجراء مع وسيطة اسم المجلد أو القرص ، مثال : Call ShowFileList("C:\My Documents") - لمعرفة حجم ونوع ملف Dim fs, f, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile("c:\My Documents\db1.mdb") s = " اسم الملف هو :" & UCase(f.Name) & " وحجمه : " & "(" & (f.Size) & ")" & " ونوعه : " & f.Type MsgBox s, vbMsgBoxRight + vbMsgBoxRtlReading, "معلومات ملف" - لإظهار قائمة بأسماء ملفات الخطوط وليس أسماء الخطوط Dim fs, f, f1, fc, s Dim الملفات As String Dim الكل As Variant Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("C:\WINDOWS\FONTS") Set fc = f.Files For Each f1 In fc If f1.Type = "ملف خط تروتايب" Then الملفات = f1.Name If IsEmpty(الكل) Then الكل = الملفات Else الكل = الكل & ";" & الملفات End If End If Next List1.RowSource = UCase(الكل) - لمعرفة حجم ونوع مجلد Dim fs, f, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("c:\My Documents") s = " اسم المجلد هو :" & UCase(f.Name) & " وحجمه : " & "(" & (f.Size) & ")" & " ونوعه : " & f.Type MsgBox s, vbMsgBoxRight + vbMsgBoxRtlReading, "معلومات مجلد" - لإعادة اسم ملف من دليل : Dim fs, f Set fs = CreateObject("Scripting.FileSystemObject") MsgBox fs.GetFileName("c:\My Documents\db1.mdb") يعيد السطر الأخير اسم الملف الموجود بعد اسم المجلد . ولإعادة المجلد كاملاً استخدم : MsgBox fs.GetFile("c:\My Documents\db1.mdb") - لإعادة المجلد بعد المحرك من دليل : Dim fs, f Set fs = CreateObject("Scripting.FileSystemObject") MsgBox fs.GetParentFolderName("c:\KPCMS\My Documents") - لنقل ملف استخدم الطريقة MoveFile Dim fs, f Set fs = CreateObject("Scripting.FileSystemObject") fs.MoveFile "c:\My Documents\سوند فورج.htm", "c:\My Documents\My Htmal\" - نقل مجلد باستخدام MoveFolder Dim fs, f Set fs = CreateObject("Scripting.FileSystemObject") fs.MoveFolder "c:\المجلد المطلوب نقله", "c:\المجلد الذي سينقل إليه المجد السابق\" - لإظهار قائمة بالمجلدات قم باستدعاء التالي: Sub ShowFolderList(folderspec) Dim fs, f, f1, s, sf Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(folderspec) Set sf = f.SubFolders For Each f1 In sf s = s & f1.Name s = s & vbCrLf Next MsgBox s End Sub ولجعلها تظهر في قائمة منسدلة : Dim fs, f, f1, s, sf Dim الكل As Variant Dim كل_المجلدات As String Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder([قرص]) Set sf = f.SubFolders For Each f1 In sf كل_المجلدات = f1.Name If IsEmpty(الكل) Then الكل = كل_المجلدات Else الكل = الكل & ";" & كل_المجلدات End If Next Me![اسم القائمة المنسدلة].RowSource = الكل مع وضع وسيطه إما محرك أقراص أو مجلد ، مثال : Call ShowFolderList("c:\") — لإظهار كافة المجلدات في قرص أو دليل وطباعتها في الدبج : MyPath = "c:\" MyName = Dir(MyPath, vbDirectory) Do While MyName <> "" If MyName <> "." And MyName <> ".." Then If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then Debug.Print MyName End If End If MyName = Dir Loop ولإظهارها في قائمة منسدلة : Dim الكل As Variant Dim كل_المجلدات As String MyPath = قرص كل_المجلدات = Dir([MyPath], vbDirectory) Do While كل_المجلدات <> "" If كل_المجلدات <> "." And كل_المجلدات <> ".." Then If (GetAttr(MyPath & كل_المجلدات) And vbDirectory) = vbDirectory Then If IsEmpty(الكل) Then الكل = كل_المجلدات Else الكل = الكل & ";" & كل_المجلدات End If End If End If كل_المجلدات = Dir Loop Me![اسم القائمة المنسدلة].RowSource = الكل — لإظهار أول ملف بخاصية معينة Dim MyFile MyFile = Dir("*.TXT", vbHidden) - لإظهار معلومات عن ملف استدعي الإجراء التالي : Sub ShowFileAccessInfo(filespec) Dim fs, f, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile(filespec) s = UCase(filespec) & vbCrLf s = s & "تاريخ الإنشاء: " & f.DateCreated & vbCrLf s = s & "التشغيل الأخير: " & f.DateLastAccessed & vbCrLf s = s & "التعديل الأخير: " & f.DateLastModified MsgBox s, 0, "معلومات ملف" End Sub مع وضع وسيطه إما محرك أقراص أو مجلد ، مثال : Call ShowFileAccessInfo("c:\My Documents\do.mdb") — لتغيير اسم ملف أو مجلد للملف : Dim OldName, NewName OldName = "C:\MY Documents\1.bmp": NewName = "C:\MY Documents\خلفية.bmp" Name OldName As NewName للمجلد Dim OldName, NewName OldName = "C:\MY Documents\مجلد جديد": NewName = "C:\MY Documents\احذفه لو سمحت" Name OldName As NewName - لمعرفة نوع المجلد هل هو جذر مجلدات root folder أو مجلد داخل جذر أو مجلد آخر ومستواه Sub DisplayLevelDepth(pathspec) Dim fs Set fs = CreateObject("Scripting.FileSystemObject") Dim f, n Set f = fs.GetFolder(pathspec) If f.IsRootFolder Then MsgBox "The specified folder is the root folder." Else Do Until f.IsRootFolder Set f = f.ParentFolder n = n + 1 Loop MsgBox "The specified folder is nested " & n & " levels deep." End If End Sub ويحتاج إلى تمرير وسيطة اسم المجلد أو القرص . — لمعرفة حجم القرص الصلب والمتاح منه Sub ShowSpaceInfo(drvpath) Dim fs, d, s Set fs = CreateObject("Scripting.FileSystemObject") Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath))) s = "Drive " & d.DriveLetter & ":" s = s & vbCrLf s = s & "السعة: " & FormatNumber(d.TotalSize / 1024, 0) & " Kbytes" s = s & vbCrLf s = s & "المساحة الحرة: " & FormatNumber(d.AvailableSpace / 1024, 0) & " Kbytes" s = s & vbCrLf s = s & "المساحة المستخدمة: " & FormatNumber((d.TotalSize - d.AvailableSpace) / 1024, 0) & " Kbytes" MsgBox s End Sub يمكنك استبدال سطر المساحة الحرة بالسطر التالي وهو يؤدي إلى نفس النتيجة : s = s & "المساحة الحرة: " & FormatNumber(d.FreeSpace / 1024, 0) رسالة بمسار سطح المكتب Option Compare Database Private Enum SpecialFolderIDs sfidDESKTOP = &H0 ' سطح المكتب sfidPROGRAMS = &H2 ' البرامج sfidPERSONAL = &H5 ' شخصي sfidFAVORITES = &H6 ' المفضلة sfidSTARTUP = &H7 ' بدء التشغيل sfidRECENT = &H8 ' قائمة الملفات المفتوحة حديثا sfidSENDTO = &H9 ' إرسال إلى sfidSTARTMENU = &HB ' قائمة بدء التشغيل sfidDESKTOPDIRECTORY = &H10 ' مجلد سطع المكتب sfidNETHOOD = &H13 sfidFONTS = &H14 ' الخطوط sfidTEMPLATES = &H15 ' مؤقت sfidCOMMON_STARTMENU = &H16 sfidCOMMON_PROGRAMS = &H17 sfidCOMMON_STARTUP = &H18 sfidCOMMON_DESKTOPDIRECTORY = &H19 sfidAPPDATA = &H1A sfidPRINTHOOD = &H1B sfidProgramFiles = &H10000 sfidCommonFiles = &H10001 End Enum Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As SpecialFolderIDs, ByRef pIdl As Long) As Long Private Declare Function SHGetPathFromIDListA Lib "shell32" (ByVal pIdl As Long, ByVal pszPath As String) As Long Private Const NOERROR = 0 ثم في حدث زر الأمر أو غيره ضع التالي : Dim sPath As String Dim IDL As Long Dim strPath As String Dim lngPos As Long ' Fill the item id list with the pointer of each folder item, rtns 0 on success If SHGetSpecialFolderLocation(0, sfidDESKTOP, IDL) = NOERROR Then sPath = String$(255, 0) SHGetPathFromIDListA IDL, sPath lngPos = InStr(sPath, Chr(0)) If lngPos > 0 Then strPath = Left$(sPath, lngPos - 1) MsgBox strPath End If End If

نعم و لكن الاكواد الموجودة فى النماذج او فى وحدات نمطية منفصلة لا يمكن استرجاعها

أيضا راجع هذه المواضيع التنبه عند تكرر قيمة http://www.officena.net/ib/index.php?showtopic=581 ما هي الداله التي تحسب التكرار http://www.officena.net/ib/index.php?showtopic=1217 معرفة هل السجل له مثيل و تحديد عدد التكرار http://www.officena.net/ib/index.php?showtopic=78

يمكنك استخدام الصفر لتعبر عن ال false و -1 لتعبر عن ال True أي سالب واحد و اذا اردت استخدام ال True False Yes No فعليك بتفيذ تعريف المتغير :pp: راجع موضوع الاستعلامات الباراميترية فى دورة الاكسيس

صراحة لا أعلم ، فأنا لم أجرب و انما أفضل ال asp لهذه المسألة ، لأنه علي ما أعتقد الحل المناسب لها فما هو مطروح هنا هو تطبيق ديناميكي علي الويب ، و أعتقد أن الاكسيس حتي نسخة اكس بي ليس الحل الامثل له الا اذا كان هناك فى النسخة الجديدة للأوفيس التي صدرت مؤخرا اضافات بهذا الشأن (2003)

ابحث فى النت عن advanced office password recovery