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

و هذا كود آخر ( من موقع أجنبي ) 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

اذا قصدت تصميم نموذج بالاكسيس ، فعلي حد علمي لا يمكن ذلك و بالنسبة لل asp هي ليست معقدة ، و لكن تحتاج لان تتعلمها و هي اختصارا مزيج بين اومر لغة تحرير الصفحات html و اوامر ال SQL و اما vbscript او Java script أي أنها تعتبر بيئة تجمع بين هذه الامور و ليست لغة مستقلة و ان أردت ، فلي سلسلة دروس تغطي ال html بالكامل ، و هي منشورة فى قسم الدروس فى موقع الفريق العربي للويب و أسأل الله أن يتاح لي اكمال باقي ال asp بالكامل ، و لكن يصعب علي توفير الوقت حاليا دروس الهتمل http://www.arab-team.com/lesson/html_lesson/ و ال html تعتبر اكثر من ثلث الطريق الي ال asp أو أي لغة برمجة ويب أخري و بالنسبة لصفحات الاكسيس ، فلم أجرب استخدامها علي النت ، و اعتقد أنها معدة اصلا للاستخدام علي الانترانت ( فى شبكة داخلية ) لكن معلوماتي بخصوصها ليست مكتملة و تنقصها التجربة ، و لكن كما قرات فى الرابط السابق من موقع ميكروسوفت يمكن تشغيلها علي الانترنت مع مراعاة الاعتبارات فى المقال .

ما شاء الله :d موضوع رائع جدا (y) جزاك الله خيرا

اذا قصدت النشر فقط فيمكنك عمل تصدير التقريربصيغة htm أو html فيمكنك نشر هذه الصفحة و يمكنك استخدام صفحات الاكسيس data access page ، و لكنها تحتاج لاعتبارات خاصة للتعامل مع الانترنت ، منها تحميل ال Microsoft Office Web Components علي جهاز المستخدم صراحة لم أجربها و لكني استخدم ال asp للتعامل مع الاكسيس بالويب كما فى النفطة التالية ، و لكن اذا اردت المزيد حول صفحات الاكسيس ، فراجع الموضوع التالي فى موقع ميكروسوفت http://support.microsoft.com/default.aspx?...kb;en-us;291783 و به عدة وصلات ايضا مفيدة بهذا الشأن اما اذا أردت تفاعلا مع المستخدم يتقنيات الويب كما تراها فى اغلب المواقع التي تتعامل مع قواعد بيانات اكسيس او اس كيو ال فعليك بتقنية ال asp للتعامل مع قواعد باينات الاكسيس او الاس كيو ال و هي تعني active server pages و هي تقنية للتعامل مع قواد البيانات من خلال الويب و للمزيد عنها يمكنك مراجعة منتديات الويب ( راجع صفحة مواقع مفيدة فى الصفحة الرئيسية )

الفرق المعلن هم عدم امكانية التعديل فى النماذج و التقارير و هذه ثبت أنها غير سليمة و ان التعديل ممكن ببعض التحايل الفرق الاهم هو ان الكود يتم عمل compilation لها بحيث تكون غير ظاهرة و لا يمكن التعديل فيها و من المفرض أن نسخ ال mde أفضل فى الاستخدام من حيث السرعة و الاهم هو تلافي التعديلات الغير مقصودة و تعريف من موضوع فى موقع ميكروسوفت : An MDE file is a Microsoft Access database file with all modules compiled and all editable source code removed أي ان ملف ال mde هو ملف Mdb و قد تم عمل Compilation للاكواد ، و تم ازالة امكانية التعديل منها كلها و هذا الملف يكون حجمه أصغر من ال mdb و أعتقد أن اداؤه أفضل

فى حدث عند الفتح لنموذج حدد المقاس الصغير DoCmd.MoveSize , , 5000, 3000 ثم لفتح النموذج بالحجم الكامل DoCmd.MoveSize , , 12000, 6500 و للعودة الي المقاس الصغير DoCmd.MoveSize , , 5000, 3000 و ايضا يمكنك استغلال نفس الامر لتحديد المكان و ليس الحجم فقط مثل DoCmd.MoveSize 100,150,5000, 3000

اذا كانت الجملة كلها تكتبها مباشرة جرب الكتابة هكذا 1-11-1998 و ليس 1/11/1998

السلام عليكم و رحمة الله و بركاته أهلا أخي فهد ساضع تصور سريع لكي لا أتأخر عليك ، و ارجو أن يكون واضحا ما أراه الأنسب هو التعامل مع المحلات بنفس طريقة المخازن فى هذ1 المثال http://www.officena.net/ib/index.php?showtopic=306 ( راجع رسم الجداول به ) ففي الأغلب سيكون مناسبا هنا ايضا فكل محل يمثل مخزن له أوامر توريد و لها تفاصيل ( جدولان ) و أوامر سحب و لها تفاصيل ( جدولان ) و اومر السحب و التوريد و تفاصيل كل منها تسجل فى 4ال جداول السابقة كتفاصيل للاوامر و بعد التسجيل يتم ترحيل البيانات الي جدول الحركات ( الذي تسجل به جميع حركات التوريد و الصرف )اي التنفيذ ( تنفيذ الامر فينفذ فى جدول الحركات ) و يمكن التعامل مع مسحوبات النقود علي أنها مادة من المواد أو فى جداول منفصلة ، و أفضل الاولي ، أنها مادة كميتها هي قيمتها و فئتها دائما واحد و نلاحظ أن كل أمر سحب أو اضافة فهو مقترن بمخزن معين ، و فى حالتك بمحل معين ، فهو اما اضافة الي المحل و سحب من المحل و فى الحالة التي ذكرت سيتم اضافة المحلات الي الموردين والعملاء بحيث أن هناك محل يورد الي محل آخر و محل يسحب من محل آخر و امامك حلان عند تسجيل حركة التحويل من محل 1 الي محل 2 الاول ان تقوم بعمل امر صرف من محل 1 الي العميل محل 2 لينتقص من رصيد محل 1 و يليه امر توريد من المورد محل1 الي المحل رقم 2 ليزيد من رصيد محل رقم 2 و الثاني أن نفذهما بالكود فى خطة واحدة لتسجيل نفس السجلان فى جدول الحركات مع تحياتي

استخدم الدالة Format "start date " & format(me.date,"dd/mm/yyyy") & "Exactly "

هذا هو الكود للربط و أيضا كود لطباعة العلاقات الي نافذة ال debug 'create a relation '================= Sub CreateRelationDAO() Dim dbsLocal As Database Dim relLocal As Relation Dim fldLocal As Field Set dbsLocal = CurrentDb Set relLocal = dbsLocal.CreateRelation() With relLocal .Name = "PeopleFood" .Table = "tblFoods" .ForeignTable = "tblPeople" .Attributes = dbRelationDeleteCascade End With Set fldLocal = relLocal.CreateField("FoodID") fldLocal.ForeignName = "FoodID" relLocal.Fields.Append fldLocal dbsLocal.Relations.Append relLocal End Sub 'print relation '================ Sub EnumRelations() Dim dbsLocal As Database Dim relLocal As Relation Set dbsLocal = CurrentDb For Each relLocal In dbsLocal.Relations Debug.Print relLocal.Table & " Related To: " & relLocal.ForeignTable Next relLocal End Sub

لحماية الأكواد بكلمة سر افتح محرر البيزيك ( ALT+F11) Tools Project Properties Protection و اختار عدم اظهار الكود Lock Project For Viewing و اكتب كلمة السر و أكدها و اجعلها طويلة و خليط بين الارقام و الحروف لتصعيب المهمة علي برامج الاختراق

هذا الشرح و المثال للأخ فيصل الحربي: ========================= طريقة إخفاء شاشة الأكسس السلام عليكم ورحمة الله وبركاته إليكم طريقة إخفاء شاشة الأكسس نهائيا بعد فتح النموذج المطلوب 1- انشئ قاعدة بيانات جديده 2- انسخ الكود التالي ثم الصقه في وحده نمطيه جديدة وسمها أي اسم ترغب به الكود =============================================== Option Compare Database Option Explicit Global Const SW_HIDE = 0 Global Const SW_SHOWNORMAL = 1 Global Const SW_SHOWMINIMIZED = 2 Global Const SW_SHOWMAXIMIZED = 3 Private Declare Function apiShowWindow Lib "user32" _ Alias "ShowWindow" (ByVal hwnd As Long, _ ByVal nCmdShow As Long) As Long Function fSetAccessWindow(nCmdShow As Long) 'Usage Examples 'Maximize window: ' ?fSetAccessWindow(SW_SHOWMAXIMIZED) 'Minimize window: ' ?fSetAccessWindow(SW_SHOWMINIMIZED) 'Hide window: ' ?fSetAccessWindow(SW_HIDE) 'Normal window: ' ?fSetAccessWindow(SW_SHOWNORMAL) ' Dim loX As Long Dim loForm As Form On Error Resume Next Set loForm = Screen.ActiveForm If Err <> 0 Then 'no Activeform If nCmdShow = SW_HIDE Then 'MsgBox "Cannot hide Access unless " _ & "a form is on screen" Else loX = apiShowWindow(hWndAccessApp, nCmdShow) Err.Clear End If Else If nCmdShow = SW_SHOWMINIMIZED And loForm.Modal = True Then 'MsgBox "Cannot minimize Access with " _ & (loForm.Caption + " ") _ & "form on screen" ElseIf nCmdShow = SW_HIDE And loForm.PopUp <> True Then 'MsgBox "Cannot hide Access with " _ & (loForm.Caption + " ") _ & "form on screen" Else loX = apiShowWindow(hWndAccessApp, nCmdShow) End If End If fSetAccessWindow = (loX <> 0) End Function =============================================== 3- انشئ نموذج جديد وسمه اي اسم ترغب به 4- غير خصائص النموذج الى pop up=yes modal=yes منبثق = نعم = pop up شكلي او مشروط = نعم = Modal 5- ضع زر امر لإغلاق النموذج مع الأكسس 6- ضع في حدث عند الفتح الكود التالي الكود ============================================== fSetAccessWindow (SW_SHOWMINIMIZED) fSetAccessWindow (SW_HIDE) ============================================== 7- من قائمة أدوات اختر بدء التشغيل ثم حدد النموذج لكي يفتح في بدء التشغيل 8- إحفظ عملك ثم قم بإنهاء القاعدة . 9- شغل القاعدة وسوف ترى ان خلفية الأكسس مختفيه تماما ما عدا النموذج الذي اخترته من قائمة بدء التشغيل . 10 -دعواتكم لنا بالتوفيق مرفق مثال على الطريقة hideaccesswindow_Faisal.zip

اذا لا توجد حاجة ملحة لبرامج خارجية :( شكرا علي المعلومة مع تحياتي

جزاك الله خيرا أخي أحمد و شكرا علي المثال :( ما البرنامج الذي استخدمته فى اعداد ملف المساعدة ؟؟

بناء علي طلب أحد الأخة تم اضافة الكود السابق فى مثال توضيحي و الكود يمكن تنفيذه فى خطو واحد بدمج ناتج ال inputbox مباشرة فى معادلة الشرط if أو علي خطوتين و المثال يشمل كلاهما بالنسبة لل InputBox فالمعاملات الثلاثة فى التعبير الاول يوضع به الرسالة التي تظهر فى مربع الحوار الثاني يوضع به عنوان مربع الحوار الثالث القيمة الافتراضية و لها معاملات أخري و لكن تستخدم بصورة أقل بالنسبة لجملة الشرط فتنقسم الي 3 أجزاء الشرط ، و ماذا اذا تحقق الشرط ، ثم ماذا لو لم يتحقق و فى هذا المثال الشرط هو ان ما يدخله الستخدم = 123 و تبدأ جملة الشرط ب IF ثم الشرط و يلي ذلك then نكتب الكود الذي ينفذ حال تحقق الشرط و يلي ذلك else ثم الكود الذي ينفذ حال عدم تحقق الشرط ثم نختم جملة الشرط ب end if و ممكن استخدام حالة تحقق الشرط فقط مثل If x = 4 then msgbox "4" end if و فى هذه الحالة من الممكن استبدال المعادلة ب if x=4 then msgb "4" و الاستغناء عن end if openPass.rar