taha2002

الله يجزاكخير ويكتبها في ميزان حسناتك

اخواني عندي برنامج على شبكة وتم تقسيم البرنامج جزء خاص بالنماذج والتقارير والجزء الاخر خاص بالجداول استخدمت دالة النسخ الاحتياطي لعمل نسخة طبق الاصل من البرنامج وبها تم نسخ الجزء الذي يحتوي على النماذج والتقارير فقط ولم يتم نسخ الجزء المهم وهو الخاص الجداول فارجو مساعدتي في تعديل كود الدالة او دالة جديدة تمكن مستخدم البرنامج من نسخ الجزء المحتوي على data الجداول هذا هو محتوى الدالة Function fMakeBackup() As Boolean Dim strMsg As String Dim tshFileOp As SHFILEOPSTRUCT Dim lngRet As Long Dim strSaveFile As String Dim lngFlags As Long Dim FolderToCopy Const cERR_USER_CANCEL = vbObjectError + 1 Const cERR_DB_EXCLUSIVE = vbObjectError + 2 On Local Error GoTo fMakeBackup_Err If fDBExclusive = True Then err.Raise cERR_DB_EXCLUSIVE strMsg = "åá ÊÑíÏ Úãá äÓÎÉ ÅÍÊíÇØíÉ áåÐÇ ÇáÈÑäÇãÌ ¿" If MsgBox(strMsg, vbQuestion + vbYesNo + vbMsgBoxRight + _ vbMsgBoxRtlReading, "ÊÃßíÏ ÇáäÓÎ") = vbNo Then _ err.Raise cERR_USER_CANCEL lngFlags = FOF_SIMPLEPROGRESS Or _ FOF_FILESONLY Or _ FOF_RENAMEONCOLLISION strSaveFile = CurrentDb.NAME With tshFileOp .wFunc = FO_COPY .hwnd = hWndAccessApp .pFrom = CurrentDb.NAME & vbNullChar FolderToCopy = BrowseForFolder If Len(FolderToCopy & "") = 1 Then Exit Function Else .pTo = FolderToCopy End If .fFlags = lngFlags End With lngRet = apiSHFileOperation(tshFileOp) fMakeBackup = (lngRet = 0) fMakeBackup_End: Exit Function fMakeBackup_Err: fMakeBackup = False Select Case err.Number Case cERR_USER_CANCEL: 'do nothing Case cERR_DB_EXCLUSIVE: MsgBox "The current database " & vbCrLf & CurrentDb.NAME & vbCrLf & _ vbCrLf & "is opened exclusively. Please reopen in shared mode" & _ " and try again.", vbCritical + vbOKOnly, "Database copy failed" Case Else: strMsg = "Error Information..." & vbCrLf & vbCrLf strMsg = strMsg & "Function: fMakeBackup" & vbCrLf strMsg = strMsg & "Description: " & err.Description & vbCrLf strMsg = strMsg & "Error #: " & Format$(err.Number) & vbCrLf MsgBox strMsg, vbInformation, "fMakeBackup" End Select Resume fMakeBackup_End End Function Private Function fCurrentDBDir() As String Dim strDBPath As String Dim strDBFile As String strDBPath = CurrentDb.NAME strDBFile = Dir(strDBPath) fCurrentDBDir = Left(strDBPath, InStr(strDBPath, strDBFile) - 1) End Function Function fDBExclusive() As Integer Dim hFile As Integer hFile = FreeFile On Error Resume Next Select Case err Case 0 fDBExclusive = False Case 70 fDBExclusive = True Case Else fDBExclusive = err End Select Close hFile On Error GoTo 0 End Function Private Sub ÃãÑ0_Click() Call fMakeBackup End Sub Private Function BrowseForFolder() Dim bi As BROWSEINFO Dim IDL As ITEMIDLIST Dim pidl As Long Dim r As Long Dim pos As Integer Dim spath As String Dim lblSelected As String bi.pidlRoot = 0& bi.lpszTitle = "ÍÏÏ æÌåÉ ÇáäÓÎÉ ÇáÃÍÊíÇØíÉ :" bi.ulFlags = BIF_RETURNONLYFSDIRS pidl& = SHBrowseForFolder(bi) spath$ = Space$(512) r = SHGetPathFromIDList(ByVal pidl&, ByVal spath$) If r Then pos = InStr(spath$, Chr$(0)) 'pos = spath lblSelected = Left(spath$, pos - 0) Else: lblSelected = "" End If BrowseForFolder = lblSelected & "\" End Function فارجو من اخواننا المشرفين والاعضاء مساعدتي وله مني خالص الدعاء

الله يجزاك الجنة ان شاء الله

فشلت في تطبيق الدالة dmax في عملية البحث بحثت في جميع الامثلة في المنتدى ولم اجد مثال واحد يستخدم الدالة dmax في عملية البحث فارجو مساعدتكم وهذه هي بيانات قاعدتي هي id رقم_العقد اسم الجدول هو gest_tbl اسم الحقل الذي نريد البحث فيه هو الشقة ارغب في عمل command بالضغط عليه يبحث عن اخر مرة تم استخدام الشقة رقم 3 ويتم كتابته في مربع نص TEXT علما بان الشقة رقم 3 تم استخدامها اكثر من مرة في الجدول من يستطيع المساعة يحاول وضع مثال ومن يستطيع المساعده فله مني خالص الدعاء بدوام الصحة والعافية