Moosak

شكرا لك أخي أكرم .. 🙂 إن شاء الله تكون لي تجربة معه بإذن الله 🌹

وعليكم السلام ورحمة الله وبركاته أخي محب العقيدة 🙂 منك العذر أخي العزيز ،، فهذا الموضوع لم يأخذ حقه من الإشادة والثناء ☺️ شرح جميل وواضح وجهد مبذول تستحق عليه جزيل الشكر والتقدير .. 🌹🌹🌹 ويتضح من خلال سلاستك في السرد و (إيجاد الحلول للمشاكل التي يمكن أن تواجه المصمم) أن لك باعا طويلا في هذا النوع من قواعد البيانات .. وفقك الله ربما لما أستوعب جميع ما ذكرت حتى أخوض غمار التجربة بنفسي ..😅🖐🏼️ ولعله تكون لنا عودة مرة أخرى لاستيضاح ما قد نواجهه مستقبلا عند التجربة على أرض الواقع 😉👌🏼 وفقك الله أخي العزيز وبارك الله لك في علمك وحالك ومالك وذريتك ..🌹🤲🏼😊 وربما نجد عندك أيضا بعض الحلول الإبداعية لحل بعض القضايا مثل : إعادة الاتصال بقاعدة البيانات تلقائيا أو بواجهة سهلة كم هو الحال في هذا الموضوع : أو كيفية الكشف عن ما إذا كانت القاعدة متصلة أم لا ؟ ... وغيرها من الأمور ..

بعد البحث وجدت أن الموضوع له امتداد هنا ... ولكن المشكلة لم تحل من يومها 😅🖐🏼️

بالنسبة للمكتبة .. اشتغل الكود بنجاح عندما أزلت المكتبة السابقة .. فقام البرنامج بإضافتها من جديد .. ولكن المشكلة الثانية باقية كما هي ..

أخي أكرم .. أكرمك الله من واسع فضله 🙂 عند تجربة الملف واجهت أمرين .. الأول : لم يتعرف البرنامج تلقائيا على المكتبة التالية : ولكن أضفتها يدويا من خلال ملف SQLDMO.DLL المرفق .. الثاني : عند الضغط بعدها على زر [ اختيار السيرفر ] تظهر لي رسالة الخطأ التالية : فيتوقف الكود ولا يجلب أسماء السيرفرات المتوفرة .. ويبدو لي أن هناك Class ناقص في البرنامج .. ما هو رأيك ؟

وعليك السلام ورحمة الله وبركاته أخي محمد 🙂 إذهب لمحرر الأكود وتأكد من إضافة المكتبة التالية :

وعليكم السلام ورحمة الله وبركاته أخي علي 🙂 استخدم دالة weekDay(Date)

وعليكم السلام ورحمة الله وبركاته أخي العنزي 🙂 تفضل هذه هي الطريقة : والنتيجة : Prog1.rar

هل نسخة الأوفيس لديك مرخصة وكاملة ؟ وهل ضبطت المواقع الموثوقة في البرنامج لديك؟

ربما يفيدك قناع الإدخال في هذا الموضوع ..

وعليكم السلام ورحمة الله وبركاته 🙂 استخدم داله Dlast.. Nz(Dlast("[fieldName]";"[TableName]"))+1

وعليكم السلام ورحمة الله وبركاته 🙂 وهنا أيضا :

نعم تماما كما ذكرت مهندسنا العزيز .. وأضيف أني أرى من الأسهل استخدام خاصية الـ Tag بوضع علامة معينة عليه للعناصر المراد التحكم بها ( وذلك للخروج من متاهات أسماء العناصر وأنواعها ) 😅 نضع العلامة أو الرمز هنا : ثم نستخدمها في الكود هكذا : For Each ctl In Me.Controls If ctl.Tag = "*" Then ctl.BackColor = RGB(150, 180, 215) End If Next ctl طبعا الشرح للمبتدأين أمثالي .. أما لكم أنتم فمن باب " وذكّر ... " 😁

ذكرني هذا الموضوع بمنشور قديم تم استخدام نفس التقنية فيه 😊👌🏻 .. أعيد تذكيركم به .. مع إسبال الشكر الجزيل للأساتذة الأعزاء المهندسين قاسم وخالد .. نفعنا الله بهما .. وأمد في أعمارهما 🙂🌹

ما شاء الله فكر أمني وطريقة جيدة للاحتراز من العبث 🙂 وهل تقوم بتغيير الامتداد يدويا عند الاستعادة ؟

وعليكم السلام ورحمه الله وبركاته 🙂 تفضل هذا كود تصدير استعلام معين إلى ملف أكسل - نقلته كما هو بدون تعديل - وطريقة استخدامه مشروحة في الكود : '--------------------------------------------------------------------------------------- ' Procedure : Export2XLS ' Author : Daniel Pineault, CARDA Consultants Inc. ' Website : http://www.cardaconsultants.com ' Purpose : Export recordset to Excel ' Copyright : The following may be altered and reused as you wish so long as the ' copyright notice is left unchanged (including Author, Website and ' Copyright). It may not be sold/resold or reposted on other sites (links ' back to this site are allowed). ' ' Input Variables: ' ~~~~~~~~~~~~~~~~ ' sQuery : Name of the table, or SQL Statement to be used to export the records ' to Excel ' ' Usage: ' ~~~~~~ ' Export2XLS "qryCustomers" ' Call Export2XLS("qryCustomers") ' ' Revision History: ' Rev Date(yyyy/mm/dd) Description ' ************************************************************************************** ' 1 2012-Apr-18 Initial Release ' 2 2015-May-01 Header Clarifications '--------------------------------------------------------------------------------------- Function Export2XLS(ByVal sQuery As String) Dim oExcel As Object Dim oExcelWrkBk As Object Dim oExcelWrSht As Object Dim bExcelOpened As Boolean Dim db As DAO.Database Dim rs As DAO.Recordset Dim iCols As Integer Const xlCenter = -4108 'Start Excel On Error Resume Next Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one Err.Clear On Error GoTo Error_Handler Set oExcel = CreateObject("Excel.Application") bExcelOpened = False Else 'Excel was already running bExcelOpened = True End If On Error GoTo Error_Handler oExcel.ScreenUpdating = False oExcel.Visible = False 'Keep Excel hidden until we are done with our manipulation Set oExcelWrkBk = oExcel.Workbooks.Add() 'Start a new workbook Set oExcelWrSht = oExcelWrkBk.Sheets(1) 'Open our SQL Statement, Table, Query Set db = CurrentDb Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot) With rs If .RecordCount <> 0 Then 'Build our Header For iCols = 0 To rs.Fields.Count - 1 oExcelWrSht.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name Next With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _ oExcelWrSht.Cells(1, rs.Fields.Count)) .Font.Bold = True .Font.ColorIndex = 2 .Interior.ColorIndex = 1 .HorizontalAlignment = xlCenter End With 'Copy the data from our query into Excel oExcelWrSht.Range("A2").CopyFromRecordset rs oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _ oExcelWrSht.Cells(1, rs.Fields.Count)).Columns.AutoFit 'Resize our Columns based on the headings oExcelWrSht.Range("A1").Select 'Return to the top of the page Else MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with" GoTo Error_Handler_Exit End If End With ' oExcelWrkBk.Close True, sFileName 'Save and close the generated workbook ' 'Close excel if is wasn't originally running ' If bExcelOpened = False Then ' oExcel.Quit ' End If Error_Handler_Exit: On Error Resume Next oExcel.Visible = True 'Make excel visible to the user rs.Close Set rs = Nothing Set db = Nothing Set oExcelWrSht = Nothing Set oExcelWrkBk = Nothing oExcel.ScreenUpdating = True Set oExcel = Nothing Exit Function Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: Export2XLS" & vbCrLf & _ "Error Description: " & Err.Description _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Function

وعليكم السلام ورحمة الله وبركاته 🙂 نعم ممكن عن طريق استعلام الحذف .. بحيث تضع الشرط الذي تريد الحذف على أساسه في خانة المعيار في الاستعلام .

بدل هذا السطر .. أنقل التركيز إلى أي عنصر آخر خارج النموذج الذي تريد إخفائه .. وسيعمل معك إن شاء الله 🙂

بالنسبة لاسم الملف nam يمكنك اختصاره هكذا ، مع تصحيح امتداد اسم الملف : nam = "Acc_Tavuk_" & Format(Now,"dd-mm-yyyy_hh-nn-ss am/pm" & ".Accdb"

وعليك السلام ورحمة الله وبركاته أخي صابر 🙂 جرب الآن ... dlookup problem.rar

وعليك السلام ورحمة الله وبركاته أخي محمد 🙂 أضف هذين السطرين إلى أمر عند النقر للصور : Private Sub ãÑÝÞ1_Click() [Forms]![a3]![a2]![ss] = Me.ImageName ' أضف هذين السطرين [Forms]![a3]![a2]![ss].SetFocus Me.Visible = False End Sub

بالمناسبة أخي عبدالله جربت الكود الخاص بك واشتغل معي تمام .. ولكن مع بعض التعديلات والتي ربما هي سبب المشكلة عندك : أعتقد أن المشكلة في أحد هذين السطرين ، قد تكون المسارات غير موجودة لذلك لا يستطيع نسخ القاعدة لديك ..

وعليكم السلام ورحمة الله وبركاته أخي محمد 🙂 أنظر هنا :

وعليكم السلام ورحمة الله وبركاته أخي عبدالله 🙂 لو صورت الجزئية التي يقف عليها المؤشر بالأصفر عند الضغط على ال Debug وعلى العموم يمكنك ببساطة تغيير الكود .. هناك الكثير من الأكواد التي تؤدي نفس العمل .. 🙂 هذا الكود الذي أستخدمه أنا ويعمل معي جيد ، الكود يأخذ نسخة لقاعدة البيانات كلها إذا كانت غير مقسمة . وإذا كانت مقسمة فإنه ينسخ ملف الجداول فقط . وفي كلا الحالتين الكود ينشئ النسخة في مجلد اسمه Backup بجانب البرنامج : Public Sub Backupme() On Error GoTo MyErr Dim OldFile, NewFile, CopyMyDB, wheretoBackup, BackupFolder, DBName As String If IsNull(DLookup("Database", "MSysObjects", "Type=6")) Then OldFile = CurrentProject.FullName wheretoBackup = CurrentProject.Path Else OldFile = DLookup("Database", "MSysObjects", "Type=6") wheretoBackup = Left(OldFile, InStrRev(OldFile, "\")) End If BackupFolder = wheretoBackup & "\Backup" On Error Resume Next If Len(Dir(BackupFolder)) = 0 Then MkDir BackupFolder Else End If On Error GoTo MyErr DBName = Left(CurrentProject.Name, InStrRev(CurrentProject.Name, ".") - 1) NewFile = wheretoBackup & "\Backup\" & DBName & "-Backup-" & Format(Date, "dd-mm-yyyy") & "-" & Format(Now(), "Hh-Nn-ss-AMPM.") & Right(OldFile, 5) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 MsgBox "Backup……..Done" & vbNewLine & vbNewLine & "Saved in :" & vbNewLine & NewFile, , " " MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If End Sub '=======================================(كود آخر) Public Function CreateBackup() As Boolean Dim Source As String Dim Target As String Dim a As Integer Dim objFSO As Object Dim Path As String Path = CurrentProject.Path 'get location of current folder Source = CurrentDb.Name Target = Path & "\BackupDB " Target = Target & Format(Now(), "mm-dd") & ".accdb" ' create the backup a = 0 Set objFSO = CreateObject("Scripting.FileSystemObject") a = objFSO.CopyFile(Source, Target, True) Set objFSO = Nothing End Function وهذا الكود للمهندس محمد عصام :

تفضل أخي .. استخدمت نفس الكود هنا :