نجوم المشاركات

أعتذر عن التأخير.. لن تعمل الشفرة لأنها ناقصة وهذه تكملتها Sub IAS_Out_Cs_Detail() Dim rs As DAO.Recordset Dim i As Integer Dim row, cols, col '-- data variables Dim cntr_id, cntr_name, acnt_no, iss_no, iss_typ, iss_date, crr_typ, gtotal '-- open rs to add records With CurrentDb Set rs = .OpenRecordset("IAS_Out_Cs_Detail", dbOpenDynaset) .Execute "delete * from [" & rs.Name & "]" End With '-- open text file Open App_Path & "IAS_Out_Cs_Detail.txt" For Input As #1 '-- read data from text file Do Until EOF(1) '-- read line by line Line Input #1, row '-- make condition for each layer '-- first layer If row Like "مركز*" Then cols = Split(row, vbTab) cntr_id = Right(cols(0), 4) cntr_name = cols(1) '-- second layer ElseIf row Like "الحساب*" Then cols = Split(row, vbTab) acnt_no = Split(cols(0), ":")(1) iss_no = Split(cols(1), ":")(1) iss_typ = Split(cols(2), ":")(1) iss_date = Split(cols(3), ":")(1) crr_typ = cols(13) gtotal = cols(14) '-- third layer Else cols = Split(row, vbTab) rs.AddNew rs(0) = cntr_id rs(1) = cntr_name rs(2) = acnt_no rs(3) = iss_no rs(4) = iss_typ rs(5) = iss_date rs(6) = crr_typ rs(7) = gtotal For i = 0 To UBound(cols) - 2 rs(i + 8) = cols(i) Next rs.Update End If Loop Close #1 Set rs = Nothing End Sub وهذا المرفق بعد التعديل Import Data from oracle Report.zip

جزاكم الله خيرا ، اسال الله عز وجل ان يبارك لك أستاذ محمد

استعلام لهاي . واستعلام لهاي . والنتيجة

عليكم السلام تفضل يا اخى تقييم الطلاب.xlsx

تفضل أستاذ nssj أرجو أن يكون هذا طلبك وأكون فهمت قصدك مقارنة.accdb في عمل المقارنة بين الحقلين الإستعلام سوف يعطيك الإختلاف بين الحلقين مقارنة.accdb

لهذا السبب ، الطريقة الافضل لك ، هي عمل سؤال جديد ، حتى يستطيع الاعضاء المعاصرون من الرد على سؤالك ، وبسرعة 🙂 جعفر

اخي اسلام 🙂 هذا الموضوع من 12 سنه ، فلا تتوقع رد من اصحابه !! هذا الرابط سيفيدك : اجعل برنامجك يعمل على النواتين 32بت و 64بت - قسم الأكسيس Access - أوفيسنا (officena.net) جعفر

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

المشكلة بالمصطلحات التي تستخدمها لا أدري إذا كان هذا ما تقصد Sub test() Range("C3").Resize(Cells(Rows.Count, 3).End(xlUp).Row - 3) _ .SpecialCells(4).Offset(, -1).Resize(, 8).Delete shift:=(xlUp) ActiveSheet.Range("b3:i10").PrintPreview End Sub

رجاء تجرب النتيجة الان 🙂 اصبحت الدالة هكذا: Function Add_RMZ() On Error GoTo err_Add_RMZ Dim rstT As DAO.Recordset Dim rstR As DAO.Recordset Dim rstX As DAO.Recordset Set rstT = CurrentDb.OpenRecordset("Select * From TAB") Set rstR = CurrentDb.OpenRecordset("Select * From TAB_RMZ") Set rstX = CurrentDb.OpenRecordset("Select * From TAB_RMZ_X") rstT.MoveFirst Do Until rstT.EOF rstR.MoveFirst Do Until rstR.EOF 'Debug.Print 'Debug.Print rstR!RMZ, rstT!NASS 'Debug.Print "-----------------" If InStr(rstT!NASS, rstR!RMZ & " ") > 0 Or InStr(rstT!NASS, rstR!RMZ & vbCrLf) > 0 Then 'Found it 'But is it already in TAB_MRZ_X rstX.FindFirst "[MNO]=" & rstT!MNO & " And [RMZno]=" & rstR!RMZno If rstX.NoMatch Then rstX.AddNew rstX!MNO = rstT!MNO rstX!RMZno = rstR!RMZno rstX.Update End If 'rstX.NoMatch End If 'InStr rstR.MoveNext Loop 'rstR rstT.MoveNext Loop 'rstT Exit_Add_RMZ: rstT.Close: Set rstT = Nothing rstR.Close: Set rstR = Nothing rstX.Close: Set rstX = Nothing MsgBox "Done" Exit Function err_Add_RMZ: If Err.Number = 3021 Then Else MsgBox Err.Number & vbCrLf & Err.Description End If Resume Exit_Add_RMZ End Function . جعفر 1361.RMZ02.accdb.zip

أخي الكريم .. هذه الرموز ليست للفهرسة ولا علاقة لها بالكتب .. هي رموز لأمور ومعاني متعددة متعلقة بالأحاديث من حيث السند والمتن والترتيب والموضوع .. ولها مهام متعددة .. بعضها مؤقت وبعضها دائم

جرب هذا الملف amr.xlsx

وعليكم السلام-كان عليك استخدام خاصية البحث بالمنتدى قبل رفع المشاركة-تفضل , ملفك به مشكلة فى التحميل اضافة سطر بنفس التنسيق والمعادلات

Sub filter() Range("B3:I3").Select Selection.AutoFilter ActiveSheet.Range("B3:I3").AutoFilter Field:=2, Criteria1:="<>" ActiveSheet.PrintPreview End Sub

اتفضل استاذ @haniameen تم انشاء موديول كالتالى Public Function GetCountKind(strCode As Integer, strMale As Integer) As Integer 'لعدد الذكور والاناث GetCountKind = DCount("*", "sheet", "[dept_code] = " & strCode & " and [c_male]=" & strMale) End Function Public Function GetCountReligion(strCode As Integer, strReligion As Integer) As Integer 'لعدد المسلمين والمسيحين GetCountReligion = DCount("*", "sheet", "[dept_code] = " & strCode & " and [c_moslem]=" & strReligion) End Function Public Function GetCounTotal(strCode As Integer) As Integer 'للاجمالى GetCounTotal = DCount("*", "sheet", "[dept_code] = " & strCode) End Function وتم استدعائه بالاستعلام شوف الاستعلام qryCount والتقرير rpt_qryCount بالتوفيق sheet_hani_1.mdb

جرب هذا الملف Rashidi.xlsx

السلام عليكم تقريب آخر في الملف المرفق... بن علية حاجي شيت.xls

ملفين اخرين لتشغيل الصوت عند فتح النوذج اعلمنا النتائج اخي الكريم تشغيل الصوت عند فتح النموذج.rar تشغيل الصوت بدون اظهار رسالة.rar

جرب هذا -لكن بالأكسيس وليس بالإكسيل 856793561_.mdb

السلام عليكم فى البداية يجب ان اشكر كل العاملين على هذا المنتدى الرائع الذى لولاه ما كنت لاتقدم فى استخدام الاكسيل بهذا الشكل :بالنسبة للموضع الملف المرفق عبارة عن ملف معد لادارة محل منظفات لكنى واجهت بعض العقبات التى لم اعرف طريقه لحلها لذلك ارجو من الساده الاعضاء الكرام التكرم بالافادة كل التفاصيل بالملف المرفق فى انتظار ردكم الكريم منظفات.rar

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

انسخ الكود التالي في وحدة نمظية جديدة Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Private Const BIF_RETURNONLYFSDIRS = &H1 Public Function BrowseDirectory(szDialogTitle As String) As String On Error GoTo Err_BrowseDirectory Dim X As Long, bi As BROWSEINFO, dwIList As Long Dim szPath As String, wPos As Integer With bi .hOwner = hWndAccessApp .lpszTitle = szDialogTitle .ulFlags = BIF_RETURNONLYFSDIRS End With dwIList = SHBrowseForFolder(bi) szPath = Space$(512) X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath) If X Then wPos = InStr(szPath, Chr(0)) BrowseDirectory = Left$(szPath, wPos - 1) Else BrowseDirectory = "" End If Exit_BrowseDirectory: Exit Function Err_BrowseDirectory: MsgBox Err.Number & " - " & Err.Description Resume Exit_BrowseDirectory End Function الآن ضع الكود التالي في حدث عند النقر لزر أمر ليضع مسار المجلد في مربع نص اسمه : tbDirectoryName On Error GoTo Err_bBrowse_Click Dim sDirectoryName As String ' Me.tbHidden.SetFocus sDirectoryName = BrowseDirectory("Find and select where to export the report files.") tbDirectoryName = sDirectoryName Exit_bBrowse_Click: Exit Sub Err_bBrowse_Click: MsgBox Err.Number & " - " & Err.Description Resume Exit_bBrowse_Click

المرفق names.rar