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

أخي @Abdelaziz Osman هذه محاولتي بالاستعانة بكود الأستاذ @Foksh .اليك الشرح والمرفق وافني بالرد . DD453.rar

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) اليوم جئتكم بفكرة جديدة وأعتقد أنه لم يسبقني أحد بهذا الطريق ؛ وهو إضافة اختيار واجهة اللغة إلى تطبيقات وبرامج ومشاريع الآكسيس بطريقة جديدة وتقدروا تقولوا 2024 في البداية سأقوم بشرح المطلوب داخل القاعدة التي سيتم التطبيق عليها ، أولاً :- جدول واحد فقط يحتوي على حقل واحد فقط أيضاً وسنسميه بـ SettingsTable ، والحقل الذي بداخله هو Language من نوع نصي ( Text ) . ثانياً :- نموذج Settings وهو طبعاً ليس له مصدر سجلات . وبداخله كومبوبوكس Combo box سيكون اسمه cboLanguage نوع مصدر بياناته Value List ؛ ومصدر بياناته القيم التالية ( "العربية";"English" ) . ثالثاً :- بجانب قاعدة البيانات سنقوم بإنشاء مجلد جديد وسيتم تسميته بـ Language . الآن خطوات العمل :- الموديول Module :- قم بإنشاء Module جديد وسمه بـ Set_Language ؛ وهو مفتاح العمل والذي من خلاله سنعتمد على جلب الترجمة من الملفات التي سنقوم بإنشائها لاحقاً . وهذا الكود مع الشرح الكامل له بين السطور . Option Compare Database Option Explicit ' المتغير العام لتخزين اللغة الحالية Public CurrentLanguage As String ' تحديث اللغة الحالية Public Sub UpdateLanguage() On Error Resume Next ' احصل على اللغة المحددة من جدول الإعدادات CurrentLanguage = DLookup("Language", "SettingsTable") ' قم بتحديث العلامات في جميع النماذج UpdateLabelsInAllForms End Sub ' تحديث العلامات في جميع النماذج Private Sub UpdateLabelsInAllForms() Dim frm As AccessObject ' تحديث العلامات في جميع النماذج المحملة For Each frm In CurrentProject.AllForms If frm.IsLoaded Then UpdateLabelsInForm Forms(frm.Name) End If Next frm End Sub ' تحديث العلامات في نموذج محدد Private Sub UpdateLabelsInForm(frm As Object) Dim arFile As String, enFile As String Dim arLabels() As String, enLabels() As String Dim i As Integer ' احصل على ملف اللغة العربية واللغة الإنجليزية arFile = GetLanguageFilePath("Arabic.txt") enFile = GetLanguageFilePath("English.txt") ' اقرأ الملفات واملأ المصفوفات بالنصوص المترجمة arLabels = Split(ReadFile(arFile), vbCrLf, -1) enLabels = Split(ReadFile(enFile), vbCrLf, -1) ' قم بتحديث العلامات في النموذج For i = 0 To UBound(arLabels) UpdateLabel frm, "Label" & CStr(i + 1), arLabels(i), enLabels(i) UpdateLabel frm, "Command" & CStr(i + 1), arLabels(i), enLabels(i) Next i End Sub ' احصل على مسار قاعدة البيانات الحالية Private Function GetDatabasePath() As String Dim dbPath As String dbPath = CurrentDb.Name GetDatabasePath = Left(dbPath, InStrRev(dbPath, "\")) End Function ' احصل على مسار ملف اللغة Private Function GetLanguageFilePath(fileName As String) As String GetLanguageFilePath = GetDatabasePath() & "Language\" & fileName End Function ' اقرأ ملف النص وارجع النص كنص نصي Private Function ReadFile(filePath As String) As String Dim fileNumber As Integer fileNumber = FreeFile Open filePath For Input As fileNumber ReadFile = Input$(LOF(fileNumber), fileNumber) Close fileNumber End Function ' تحديث علامة محددة في النموذج بناءً على اللغة الحالية Private Sub UpdateLabel(frm As Object, labelName As String, arabicText As String, englishText As String) On Error Resume Next ' قم بتحديث العلامة بناءً على اللغة الحالية frm.Controls(labelName).Caption = IIf(CurrentLanguage = "العربية", arabicText, englishText) On Error GoTo 0 End Sub * ملاحظة :- سنعتمد هنا على طريق بسيط جداً وهو المسميات في النماذج ، فمثلاً لو انشأنا زر في نموذج ما وكانت تسميته Caption هي حفظ وكان اسم الزر Command1 ؛ فعند الترجمة سيصبح كل زر في البرنامج باسم Command1 هو بمثابة زر الحفظ وستكون ترجمته Save ؛ لذا سنعتمد طريقة توحيد المسميات في النماذج وهذا سيجعل الأمر سهلاً جداً للصيانة ، وطبعاً لا يمكن أن يكون لعنصرين ( كائنين ) في النموذج لهما نفس الإسم . رابعاً :- العودة إلى نموذج Settings الذي تم التحدث عنه في النقطة ( ثانياً ) ؛ سنقوم بدايةً باستكمال إنشاء الأكواد الخاصة بتغيير اللغة ، قبل الأحداث للـ Combo Box والنموذج . سنقوم بإدراج هذه الأكواد الثلاثة البسيطة :- ' تحديث العناصر في النموذج بناءً على اللغة المختارة Private Sub UpdateLanguageForControls() On Error Resume Next Dim ctrl As AccessObject For Each ctrl In Me.Controls ' يمكنك هنا إضافة العناصر الأخرى التي تريد تحديثها بناءً على اللغة ' مثلا: If TypeOf ctrl Is ComboBox Then Next ctrl End Sub ' حفظ اختيار اللغة في جدول SettingsTable Private Sub SaveLanguageChoice() CurrentDb.Execute "UPDATE SettingsTable SET Language='" & Me.cboLanguage & "'" End Sub ' تغيير اللغة وتحديث العناصر ذات الصلة Private Sub ChangeLanguage(selectedLanguage As String) CurrentDb.Execute "UPDATE SettingsTable SET Language='" & selectedLanguage & "'" UpdateLanguageForControls End Sub وفي حدث عند الفتح للنموذج سنقوم بإدراج هذا الكود :- ' حدث يتم تنفيذه عند فتح النموذج Private Sub Form_Open(Cancel As Integer) UpdateLanguage End Sub وفي حدث عند التحديث للكومبوبوكس سندرج الكود التالي :- ' حدث يتم تنفيذه بعد تحديث اختيار اللغة من ComboBox Private Sub cboLanguage_AfterUpdate() Dim response As VbMsgBoxResult Dim Language As String ' احصل على اللغة المحددة من ComboBox Language = Me.cboLanguage.Value ' قم بتحديد الرسالة بناءً على اللغة المختارة If Language = "العربية" Then response = MsgBox("هل ترغب في تغيير اللغة إلى العربية؟", vbQuestion + vbYesNo, "التأكيد") ElseIf Language = "English" Then response = MsgBox("Do you want to change the language to English?", vbQuestion + vbYesNo, "Confirmation") End If ' قم باتخاذ الإجراء المناسب بناءً على رد المستخدم If response = vbYes Then SaveLanguageChoice Application.Quit Else SaveLanguageChoice DoCmd.Close End If End Sub الآن نأتي لأهم نقطة في هذا الموضوع ، ألا وهي . أين ستكون الترجمة ؟ طبعاً قمنا سابقاً بإنشاء المجلد Language بجانب قاعدة البيانات ، الآن سنذهب إليه وسنقوم بإنشاء ملفين نصيين Text الأول Arabic.txt ، والثاني English.txt . في الأعلى افترضنا انه لدينا في النموذج زر اسمه Command1 والـ Caption له كانت حفظ ، الآن سنقوم بكتابة المسمى بالعربي وهو حفظ في ملف النص Arabic ، وفي الملف الثاني English سنكتب Save وهو أول أمر قمنا به كتجربة ( لاحظ أن Command يتبعها الرقم 1 ) وعليه فأن أي مسمى Command1 في أي نموذج سيكون اسمه حفظ أو Save عند اختيار الإنجليزية . وفي النهاية سأترك مرفق يحتوي تطبيق لما تحدثنا به سابقاً . والمتابعة لأي استفسار أو توضيح Change Language.zip

بارك الله فيك استاذى الكريم هو المطلوب فعلا كما اريد بالضبط بارك الله فيكم جميعا اساتذتى الكبار وجعل الله علمكم فى ميزان حسناتكم @Foksh @ابوخليل

عمل راااائع ما شاء الله تبارك الرحمن أخي @Foksh عندي سؤال : لماذا لم تحفظ الترجمة في جدول بالبرنامج بدل حفظها في ملفات خارجية ؟ 🙂 ثانيا : أضفت لمسة للبرنامج وهي أنه يقوم بإعادة تشغيل البرنامج تلقائيا بعد اختيار اللغة المطلوبة 🙂 وذلك باستخدام هذا الكود : Sub RestartAccess() Dim vbsFilePath As String vbsFilePath = CurrentProject.Path & "\Restart.vbs" ' Change the file path as needed Dim vbsContent As String vbsContent = "WScript.Sleep(2000)" & vbCrLf & _ "CreateObject(""Shell.Application"").Namespace(0).ParseName(""" & CurrentProject.FullName & """).InvokeVerb ""Open""" ' Create the VBS file and write the content Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim vbsFile As Object Set vbsFile = fso.CreateTextFile(vbsFilePath, True, False) vbsFile.Write vbsContent vbsFile.Close ' Shell execute the VBS file to restart Access Shell "wscript.exe """ & vbsFilePath & """", vbNormalFocus ' Exit Access Application.Quit End Sub Change Language.zip

وهذه محاولة لتقليص حجم الكود أيضا 🙂 Dim x As Integer For x = 1 To 8 Me("txt" & x).Visible = False Me("txtm" & x).Visible = False Next x Me.txtmst.Visible = False Me.txtstrorag.Visible = False Me.txtID.Enabled = False Me.txtitems.Enabled = False Me.txtmag.Enabled = False If Me.commanfaz = "منفذ1" Then Me.txt1.Visible = True Me.txtm1.Visible = True ElseIf Me.commanfaz = "منفذ2" Then Me.txt2.Visible = True Me.txtm2.Visible = True ElseIf Me.commanfaz = "منفذ3" Then Me.txt3.Visible = True Me.txtm3.Visible = True End If

وعليكم السلام تفضل أخي الكريم: Book1.xlsx

ولمجموع النقود استخدم DSum

هذه محاولة مني استعلام وظيفته : عمل مقارنة بين جدول الاصناف والاستعلام الذي تمت تصفيته بين تاريخين 2.accdb

استخدم الدالة DCount في مصدر اي مربع نص تريد التعداد فيه . =DCount("*", "اسم_الجدول") فقط قم بتغيير اسم الجدول حسب حاجتك .

💯💖مشكور على المجهود , مبدع

تفضل أخي @tiger wanted الشرح والمرفق حسب ما فهمت .ووافني بالرد . واذا كان هذا طلبك لاتنسى الضغط على افضل اجابة DD454-1.rar

أستاذنا الغالي @Moosak ، نورتني بكلامك الجميل ، بصراحة حبيت يكون الموضوع مختلف عما قد يخطر في البال ، ومن جهة التعديل سيكون الأمر أسهل من خارج قاعدة البيانات . وبالنسبة للمستك السحرية ، فبارك الله فيك ، وهكذا زاد الجميل جمالاً بالنسبة لي مع تصحيح اسم الدالة RestartAccess أخت صفاء ، للأسف لم أقم بتطوير الفكرة لهذا الحد ؛ ومن وجهة نظري أعتقد أن لها تبعات أخرى ومشاكل بالنسبة لموضوع الإرتساء للكائنات .

تفضل أستاذ @figo82eg محاولتي . ملحوظة : أنا حسبت (أكثر الاصناف مبيعاً وأكثر العملا شراءً ) علي الشهر السابق . أما اذا تريد الحساب قبل شهر من تاريخ اليوم (-30 يوم) . وافني بالرد . DD453.rar

لك جزيل الشكر استاذنا kkhalifa1960 عمل بالفعل رائع

هل ممكن تغيير اتجاه مربعات النص جهة اليمين فى حين اختيار اللغه الانجليزيه والعكس فى حين اختيار اللغه العربيه

بكذا انت منحت من يقوم بالتصميم راحة تامة من معاناة اختيار التسميات ... مرة ومرتين ويعتاد على هذه التسميات

جزاك الله خيرا أخى الكريم

بسيطة اخوي ، قم بإضافة شرط التاريخ مثل استعلامك الى استعلامي ، وأعطيني النتيجة

سطر أو سطرين ، الله يسامحك 😅 اذا بالسطور تقدر تخليه سطر واحد وهو إنك تحط السطور جنب بعضها وتفصل بينهم بعلامة نقطتين : ، وإذا الفكرة بتغيير المنهج اللي انت متبعه ، فجرب هذا الكود Select Case Me.commanfaz Case "منفذ1" ShowControls True Me.txtID.Enabled = False Me.txtitems.Enabled = False Me.txtmag.Enabled = False Case "منفذ2" ShowControls True Me.txt2.Visible = True Me.txtm2.Visible = True Me.txtID.Enabled = False Me.txtitems.Enabled = False Me.txtmag.Enabled = False Case "منفذ3" ShowControls True Me.txt3.Visible = True Me.txtm3.Visible = True Me.txtID.Enabled = False Me.txtitems.Enabled = False Me.txtmag.Enabled = False Case Else ShowControls False End Select Sub ShowControls(visibility As Boolean) Me.txt1.Visible = visibility Me.txtm1.Visible = visibility Me.txt2.Visible = visibility Me.txtm2.Visible = visibility Me.txt3.Visible = visibility Me.txtm3.Visible = visibility Me.txt4.Visible = visibility Me.txtm4.Visible = visibility Me.txt5.Visible = visibility Me.txtm5.Visible = visibility Me.txt6.Visible = visibility Me.txtm6.Visible = visibility Me.txt7.Visible = visibility Me.txtm7.Visible = visibility Me.txt8.Visible = visibility Me.txtm8.Visible = visibility Me.txtmst.Visible = visibility Me.txtstrorag.Visible = visibility End Sub

تفضل اخي @gavan 1.accdb

والله والله يا اخي @kkhalifa1960 مفيش كلام عارف اقوله مجهود رائع وخيالي بالنسبة لمبتدئ مثلي فعلا استا> عظيم وعلم غزير مش غير اني اقولك جزاك الله خيرا وزادك الله من علمه والله حضرتك قدمتلي اللي في دماغي خالص شكري وتحياتي لشخصك الكريم

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي يمكنك اختيار ما يناسبك Sub TEST1() Dim arr(1 To 3) As String ' المسار الافتراضي للمصنف المفتوح arr(1) = ThisWorkbook.path & "\" arr(2) = InputBox("Type in the name of the file you want to open", "Choose file name") arr(3) = Dir(arr(1) & "transactionTable" & " (" & arr(2) & ")" & ".xls*") If arr(3) <> "" Then Set Clé = Workbooks.Open(arr(1) & arr(3)) Else MsgBox ("Workbook Not Found"), vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal End If End Sub '************** ' تنشيط ورقة عمل على نفس المصنف Sub test2() Dim shname As String, x_Name As String Do Until WorksheetExists(x_Name) shname = InputBox("Type in the name of the Sheet you want to Activate") x_Name = "transactionTable" & " (" & shname & ")" If Not WorksheetExists(x_Name) Then MsgBox x_Name & " Doesn't exist!", vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal: Exit Sub Loop Sheets(x_Name).Activate End Sub Function WorksheetExists(WSName As String) As Boolean On Error Resume Next WorksheetExists = Worksheets(WSName).Name = WSName On Error GoTo 0 End Function '****************** Sub test3() Dim arr(1 To 3) As String, file_name As String ' قم بتحديد المسار الخاص بك arr(1) = "C:\Users\hicham\OneDrive\Bureau\test" arr(2) = InputBox("Type in the name of the file you want to open", "Choose file name") file_name = "transactionTable" & " (" & arr(2) & ")" arr(3) = arr(1) & "\" & file_name & ".xls" If Dir(arr(3)) = "" Then MsgBox ("Workbook Not Found"), vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal Exit Sub End If Workbooks.Open filename:=arr(3) End Sub '**************************بطرق اخرى ********************* Sub test4() Dim arr(1 To 2) As String, WS As Workbook arr(1) = InputBox("Type in the name of the file you want to open", "Choose file name") arr(2) = ThisWorkbook.path & Application.PathSeparator & "transactionTable" & " (" & arr(1) & ")" & ".xls" If Not Dir(arr(2), vbDirectory) = vbNullString Then Set WS = Workbooks.Open(arr(2)) Else MsgBox arr(2) & Chr(10) & "Workbook Not Found", 48, "Not Found" End If End Sub '***************** Sub test5() Dim arr(1 To 2) As String, WS As Workbook arr(1) = InputBox("Type in the name of the file you want to open", "Choose file name") arr(2) = ThisWorkbook.path & Application.PathSeparator & "transactionTable" & " (" & arr(1) & ")" & ".xls" If Dir(arr(2)) = "" Then MsgBox ("Workbook Not Found"), vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal Exit Sub End If Set WS = Workbooks.Open(arr(2)) End Sub test.rar

العفو اخي يسعدنا اننا استطعنا مساعدتك

اخي ربما يتعين عليك وضع حماية لورقة العمل لديك لمنع اظهار الاعمدة او اخفائها بدون ادخال كلمة المرور جرب هدا الملف باسوورد 1234 إخفاء اعمدة وصفوف برقم سري.xlsb

Public Property Get WS() As Worksheet: Set WS = Feuil1 End Property Sub Hide_Columns() col = "F:G" On Error Resume Next WS.Columns(col).Hidden = True msg = InputBox("أدخل كلمة المرور", "كلمة المرور") If msg = "1234" Then WS.Columns(col).Hidden = False Else If MsgBox("كلمة المرور غير صحيحة، حاول مرة أخرى", Yes Or No, "كلمة مرور خاطئة") = Yes Then WS.Columns(col).Hidden = True On Error GoTo 0 End If End If End Sub '************************** Sub Hide_Rows() Xrows = "13:14" On Error Resume Next WS.Rows(Xrows).Hidden = True msg = InputBox("أدخل كلمة المرور", "كلمة المرور") If msg = "1234" Then WS.Rows(Xrows).Hidden = False Else If MsgBox("كلمة المرور غير صحيحة، حاول مرة أخرى", Yes Or No, "كلمة مرور خاطئة") = Yes Then WS.Rows(Xrows).Hidden = True On Error GoTo 0 End If End If End Sub إخفاء اعمدة وصفوف برقم سري.xlsb

السلام عليكم ورحمة الله أخي الكريم، وضعت في الملف السابق إضافة بسيطة جدا وهي عبارة عن معادلات تسمح بكتابة شكل المعادلات في الجملة التي نريد حلها بعد كتابة المعاملات في الخانات المناسبة... طريقة الحل بقيت على حالها... أخوك بن علية جملة معادلتين من الدرجة الأولى ذات مجهولين_2.rar

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

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