jjafferr

وعليكم السلام انا قمت بالمطلوب حسب طلبك!! جعفر

السلام عليكم أخي كريمو كنت اعتقد بأني جربت المرفق وكان يعمل بطريقة صحيحة ، ولكن الظاهر اني كنت مخطئ ، فاعتذر منك الان وبعد التعديل ، جربته ، والظاهر انه يعمل كما يجب ، ان شاء الله الان حين تضغط على الزر "معاينة التحويل" ، فالكود يبحث عن التاريخ (شهر - سنة) الذي في النموذج ، يبحث عنه في الجدول CCP ، فاذا وجده ، فيعطيك الخيار في تحديث رقم الحساب (اي انه لن يغير القيمة) ، واذا لم يجد التاريخ في الجدول ، فيعطيك الخيار في ادخال سجل جديد جعفر 288.krimo2015V2.mdb.zip

وعليكم السلام الرابط التالي فيه الكود المطلوب ، مع مرفق http://www.officena.net/ib/topic/65067-ما-هي-طريقة-استيراد-بيانات-من-عدة-صفحات-اكسل-الى-جدول-اكسس/?do=findComment&comment=427542 جعفر

السلام عليكم أستاذ الظاهر ان موقع النور فيه نوع آخر من ملفات الاكسل ، والذي بشمل علامات لغتي الخالدة فقط ، عليه ، اليك طريقة استيرادهم ، بنفس الطريقة القديمة ، ولكن لجدول خاص به النموذج يطلب منك اختيار نوع ملف الاكسل ، والباقي يقوم الكود به . وهذا كود الاستيراد (طبعا هناك مجموعة من الاستعلامات في البرنامج): Option Compare Database Private Sub Browse_Click() Dim fpath As Variant With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Add "Excel Files", "*.xls ; *.xlsx" '.Filters.Add "Excel Files", "*.csv" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then Me.txtPath = .SelectedItems(1) End If End With Exit Sub End Sub Private Sub ImportData_Click() If Me.frm_Which_Type = 0 Then 'the user didn't choose anything, let him know MsgBox "رجاء اختيار اي نوع من الملفات تريد ان تستورد" & vbCrLf & "Please Select an option" Exit Sub ElseIf Len(Me.txtPath & "") = 0 Then 'don't leave the path empty MsgBox "رجاء اختيار ملف الاكسل" & vbCrLf & "Please select an Excel file" Exit Sub End If '1 'Empty Table Degrees and tbl_Sheets ' CurrentDb.Execute ("Delete * From Degrees") ' CurrentDb.Execute ("Delete * From tbl_Sheets") '2 'import Sheets Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection Dim strPathFile As String, strTable As String Dim strPassword As String ' Establish an EXCEL application object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change this next line to True if the first row in EXCEL worksheet ' has field names blnHasFieldNames = False ' Replace C:\Filename.xls with the actual path and filename strPathFile = Me.txtPath ' "C:\Filename.xls" ' Replace tablename with the real name of the table into which ' the data are to be imported strTable = "tbl_Sheets" '"tablename" ' Replace passwordtext with the real password; ' if there is no password, replace it with vbNullString constant ' (e.g., strPassword = vbNullString) strPassword = vbNullString '"passwordtext" blnReadOnly = True ' open EXCEL file in read-only mode ' Open the EXCEL file and read the worksheet names into a collection Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount ' Close the EXCEL file without saving the file, and clean up the EXCEL objects objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing ' Import the data from each worksheet into the table For lngCount = colWorksheets.Count To 1 Step -1 'If lngCount <> 9 And lngCount <> 8 Then GoTo Next_lngCount '3 'Empty Table Degrees and tbl_Sheets 'j'CurrentDb.Execute ("Delete * From tbl_Sheets") CurrentDb.Execute ("Delete * From " & strTable) '-- '4 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" '-- '5 If Me.frm_Which_Type = 2 Then 'the user choose Loqati ONLY add_Loqati = "_Loqati" Else add_Loqati = "" End If my_qry_Select = "qry_Select" & add_Loqati my_qry_Delete_Duplicate = "qry_Delete_Duplicate" & add_Loqati my_qry_Append = "qry_Append" & add_Loqati my_qry_Update_Sheet = "qry_Update_Sheet" & add_Loqati 'Delete Duplicate Dim rstQ As DAO.Recordset mySQL = "Select * From " & my_qry_Select Set rstQ = CurrentDb.OpenRecordset(mySQL) [F16] = rstQ![F16] [F8] = rstQ![F8] [F17] = rstQ![F17] [F29] = rstQ![F29] [F24] = rstQ![F24] rstQ.Close: Set rstQ = Nothing DoCmd.SetWarnings False DoCmd.OpenQuery my_qry_Delete_Duplicate DoCmd.SetWarnings True '------------- '6 'append the data DoCmd.SetWarnings False DoCmd.OpenQuery my_qry_Append DoCmd.SetWarnings True '------------- DoEvents Me.iSheet = colWorksheets.Count Me.iSheet2 = lngCount '------------- '7 'append the data DoCmd.SetWarnings False DoCmd.OpenQuery my_qry_Update_Sheet DoCmd.SetWarnings True '------------- '8 'empty tbl_Sheets CurrentDb.Execute ("Delete * From " & strTable) Next_lngCount: Next lngCount ' Delete the collection Set colWorksheets = Nothing MsgBox "Done" ' Uncomment out the next code step if you want to delete the ' EXCEL file after it's been imported ' Kill strPathFile End Sub جعفر 275.3.ImportDegrees.accdb.zip

وعليكم السلام شوف الرابط التالي: http://www.officena.net/ib/topic/65625-مشكله-محرجة-في-تشغيل-برنامج/#comment-427127 جعفر

يا سلام أخوي رمهان ، اعرفك فنان من زمان انت قربت الجواب بوضع رابط الموضوع ، وانا دخلت في الرابط وشايف ان المشاركة التالية هي الاقرب لسؤال أخينا أبوعبدالله http://www.officena.net/ib/topic/52619-إدارة-الجداول-المرتبطة-،-أداة-وشروحات/?do=findComment&comment=329298 جعفر

حياك الله معظم اخطاء جمع المعادلة =Sum([MK]) تكمن في القيم الفارغة في الحقل MK لذا ، يجب تحويل القيم الفارغة الى اصفار ، ثم استعمال المعادلة في الجمع هكذا =Sum(Nz([MK],0)) جعفر

وعليكم السلام أخي عبدالله عندما تقسم برنامجك الى واجهة وجداول ، ثم تضع كلمة سر على جزء الجداول ، الآن كلما تفتح الواجهة ، فانها تطلب منك كلمة سر جزء الجداول !!! للتغلب على هذا الطلب : اقسم البرنامج واجهة وجداول ، ضع كلمة سر على جزء الجداول ، في جزء الواجهة ، احذف ربط الجداول كلها ، اعد عمل الربط ، بإدخال كلمة السر ، ومن الان وصاعدا ، لا تحتاج كلمة السر لقراءة الجداول من جزء الواجهة وطبعا ستحتاج كلمة السر اذا اردت جزء الجداول مباشرة جعفر 297.FE_BE.zip

تفضل جعفر 294.تقارير.mdb.zip

واذا حذفنا الاسطر الثلاثة الاولى من ملف csv ، يمشي الحال؟ وهل السطر الاول يحتوي على اسماء الاعمدة ، او البيانات مباشرة؟ جعفر

تفضل المجموع بالدقائق: افتح النموذج frm_Dates ، وادخل التاريخين الذين تريد ان ترى النتيجة بينهما ، ثم افتح الاستعلام qry_Dates_Summary: . بقية الاشخاص لا توجد مجاميع لهم ، لأنهم في الايام المختارة لم يكن لهم استئذان. جعفر 280.2.New.accdb.zip

وعليكم السلام أخي وليد انا لم انظر في اصل المعادلة ولا كيف توصلت لها ، ولا ولا ... وانما ذهبت الى الحل بحسب معطياتك الحقل (1) هو حقلك الاصلي ، والحقل (2) A_1 (تستطيع ان تجعله مخفي) هو نسخة من حقل (1) ، ولكن بتغيير في اعدادات الحقل ، فجعلت المجموع تراكمي ، اما الحقل (3) A_2 فهو يساوي A_1 وبس . والنتيجة: . جعفر 294.تقارير.mdb.zip

وعليكم السلام شوف المثال اللي ارفقه أخي الاستاذ عبدالرحمن في الرابط التالي: http://www.officena.net/ib/topic/65649-إدراج-القيم-التابعة-لمربع-تحرير-وسرد-من-نموذج-في-نموذج-فرعي/?do=findComment&comment=427227 جعفر

وعليكم السلام الموضوع هذا جدا كبير ومتشعب لذلك ، ارفق لنا ما عندك وما توصلت اليه ، وعلى قدره نعمل لك التعديل ان شاء الله بما يفيدك جعفر

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

وعليكم السلام الكود يبحث في الجدول CCP عن وجود الشهر والسنة ، اذا لم يجده : يسألك اذا تريد اضافة السجل ، واذا قلت نعم ، يعمل AddNew ، والذي هو إضافة سجل ، ويكون آخر سجل (اذا عندك رقم تلقائي ستلاحظ هذا) ، واذا قلت لا ، لا يسجل شئ. واذا كان الشهر والسنة موجودان مسبقا (وانت تريد الادخال مرة واحدة فقط) : فيسألك اذا تريد تغيير السجل ، واذا قلت نعم ، يعمل Edit ، والذي يغير السجل الموجود ، بغض النظر عن مكان وجود الشهر في الجدول ، ، واذا قلت لا ، لا يغير شئ. فالظاهر انك لم تنتبه للرسائل التي يعطيك الكمبيوتر ، وعليه حصل ما حصل!! جعفر

وعليكم السلام ابومصطفى انت رابط النموذج الرئيسي والفرعي بأربعة حقول: nSrNo;BillnSrNo;BillnSrDate;supplierid ولكن هل لاحظت ان الحقل nSrNo مخفي وانك لم تدخل فيه اية قيمة!! هذه رسالة الخطأ ، ان القيمة فاضية!! ادخل القيم في الحقول الاربعة في النموذج الرئيسي ، ثم انتقل الى النموذج الفرعي جعفر

؟؟؟

هلا والله

وعليكم السلام المفروض هذا يؤدي الغرض Private Sub أمر2_Click() ' Dim fileLocation As String ' Dim diagFile As FileDialog ' Set diagFile = Application.FileDialog(msoFileDialogSaveAs) ' diagFile.Title = "Save Bitmap File As..." ' diagFile.InitialFileName = Me.id & ".jpg" ' If diagFile.Show Then ' fileLocation = diagFile.SelectedItems(1) Dim scanDiag As Object Dim image As Object Set scanDiag = CreateObject("WIA.CommonDialog") Set image = CreateObject("WIA.ImageFile") Set image = scanDiag.ShowAcquireImage() ' image.SaveFile fileLocation image.SaveFile Me.patth & "\" & Me.id ' End If End Sub ولكنه لم يعمل عندي ، يمكن بسبب ربط الاسكانر عندي آه نسيت اقول ، ولا حتى الكود الاصلي اشتغل عندي جعفر

تفضل وهذا هو الكود الاخير: If Len(txtMonth) = 0 Or IsNull(txtMonth) Or Not IsDate(txtMonth) Then MsgBox "Error !! SELECT A VALID Date." txtMonth.SetFocus Exit Sub ElseIf Len(Me.NCcp & "") = 0 Then MsgBox "Error !! SELECT A VALID N CCP number." Me.NCcp.SetFocus Exit Sub End If On Error GoTo Err_cmdTransfer_Click 'DoCmd.OpenReport "rptTransfer", acPreview 'DoCmd.OpenReport "rptTransfer", acViewPreview Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From CCP") rst.MoveLast: rst.MoveFirst rst.FindFirst Month(txtMonth) & Year(txtMonth) = Month(Me.txtMonth1) & Year(Me.txtMonth1) Dim Msg, Style, Title, Response If rst.NoMatch Then Msg = "This month is NOT in the table CCP" & vbCrLf & _ "Do you want to ADD A NEW RECORD ?" Style = vbYesNo + vbCritical + vbDefaultButton2 Title = "No values in CCP" Response = MsgBox(Msg, Style, Title) If Response = vbYes Then ' User chose Yes. rst.AddNew rst!NCcp = Me.NCcp rst!txtMonth = Me.txtMonth1 rst!TheValue = DSum("[TV]", "[qry_1-5_Sum]") rst.Update Else ' User chose No. GoTo Exit_Sub End If Else Msg = "The following values exist in the table CCP" & vbCrLf & _ "Account number=" & rst!NCcp & vbCrLf & _ "Month=" & rst!txtMonth & vbCrLf & _ "Value=" & rst!TheValue & vbCrLf & vbCrLf & _ "Do you want to UPDATE ?" Style = vbYesNo + vbCritical + vbDefaultButton2 Title = "values found in CCP" Response = MsgBox(Msg, Style, Title) If Response = vbYes Then ' User chose Yes. rst.Edit rst!NCcp = Me.NCcp rst!txtMonth = Me.txtMonth1 rst!TheValue = DSum("[TV]", "[qry_1-5_Sum]") rst.Update Else ' User chose No. GoTo Exit_Sub End If End If 'DoCmd.OpenQuery "qry_1-5_Sum" 'S = DSum("[TV]", "[qry_1-5_Sum]") 'MsgBox S Exit_Sub: rst.Close: Set rst = Nothing Exit_cmdTransfer_Click: Exit Sub جعفر 288.krimo2015V1.mdb.zip

اخي كامل بدل ان تكتب الكود اعلاه مباشرة في الرد ، ويكون تنسيقه عديم الفائده ، استخدم الاداة التالية (انظر السهم الاحمر): ليصبح التنسيق مقروء هكذا: DoCmd.ApplyFilter , " اللقب like '*" & [Forms]![اسم النموذج]![اسم مربع النص] & "*'" جعفر

انا لم ارى اي مرفق ، لذلك قولي ارتجالي لا تستطيع استعمال كومبو متغير في نموذج مستمر ، اي ان الكومبو تتغير قيمه حسب حقل آخر في السجل. جعفر

تعرف ليش الرسالة فارغة؟ انظر الى الكود مرة اخرى ، وستلاحظ انك استخدمت msgbox a بدل msgbox S !! اعطني دقائق وساعمل على بقية الكود جعفر تفضل هذا كود الالحاق للجدول CCP ، وطبعا تقدر قبل الادخال انك تتأكد من البيانات هذا الشهر اذا كانت موجودة (كما عملت انت في كود التقرير عند حدث الغلق) او بأي طريقة اخرى: والنتيجة: جعفر 288.krimo2015V1.mdb.zip

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