iyad mohamad

برنامج رائع استاذ موسى جزاك الله كل الخير @Moosak سأجرب تلك الطريقة و اوافيك بالرد ان شاء الله استاذي الكريم

عفوا استاذي الكريم لم انتبه انه مغلق سأرفع الملف من جديد فكرة المثال استاذي ان هذا الملف ينزل على اجهزة الشبكة كاملة على كل المستخدمين وهنا تلاحظ ان اول ما تفتح الملف في sendr id يظهر لك اسم المستخدم الشخصي للحاسوب الخاص بك هنا تستطيع ان ترسل لنفسك مثلا في حقل ال receiver id ان تكتب نفس اسمك فيظهر فورم FrmMSGViewer كتنبيه... انا هنا اريد ان ارسلت من النموذج الاول الذي هو FrmMessager عند الارسال يتلون النموذجين باللون الاصفر وعندما يتم التأكيد في receive confirm يتلون النموذجين بالاخضر لكي يعرف المرسل والمستقبل انه فعلا تم الاستلام والتأكيد @Moosak test.accdb

استاذ الكريم هذا مثال عن الشيئ الذي اريده ان ارسلت رسالة في الشبكة الى احد يتلون النموذجFRMmessager و النموذج FRMMsgviewer باللون الاخضر ان اكد على الاستقبال المستقبل و يبقى باللون الاصفر ان لم يؤكد على الاستقبال المستقبل @Moosak ولكم جزيل الفضل test.accdb

شكرا لكم اساتذتي على النصائح المهمة لكن جربت ما قلتم عنه ولكن لم ينجح معي الامر فهل هناك مثال لو تكرمتم عليي ولكم جزيل الشكر @Moosak @ابوخليل

السلام عليكم ورحمة الله كيفية عمل كود في اكسس عند الضغط على زر لارسال رسالة الى مستخدم اخر في الشبكة يتلون النموذج الخاص باستقبال الرسائل باللون الاخضر عند المستخدم الاخر على الشبكة ولكم جزيل الشكر

شكرا لك استاذي الكريم لقد نجح الامر الف شكر كتيييييييير الك جزاك الله خيرا

السلام عليكم الاساتذة الافاضل لدي مشكلة عند استدعاء قيم الحقل في جدول المستخدمين الى combobox مثل اسماء المستخدمين وليكن لدي 4 اسماء تظهر تلك الاسماء مكررة عند اختيار الاسماء في الاداة combobox هل هناك حل لعدم تكرار تلك الاسماء ولكم جزيل الشكر

السلام عليكم ورحمة الله وبركاته هل هناك طريقة لتغيير لغة البرنامج من عربي الى انكليزي لكن من دون تغيير عرض النموذج من اليسار الى اليمين اي اني اريد فقط تغيير اللغة من دون تغيير موضع العناصر في النموذج ولقد بحثت في موقعنا ووجدت هذا الموديول ايمكن تعديله فقط لتغيير اللغة من دون تغيير موضع العناصر على الشاشة ولكم جزيل الشكر وهذا هو الموديول Option Explicit Private Sub NewSource(Ctl As Control) Dim OldSource As String Dim InSource As String Dim Parts(1 To 4) As String Dim Part As Byte Dim Pos As Integer If Ctl.RowSourceType <> "Table/Query" Then Exit Sub If Ctl.ColumnCount < 3 Then Exit Sub InSource = Ctl.RowSource If InSource = "" Or Left(InSource, 7) <> "SELECT " Then Exit Sub End If Pos = InStr(1, InSource, " FROM") Parts(4) = Mid(InSource, Pos, Len(InSource)) OldSource = Left(InSource, Pos - 1) & "," For Part = 1 To 3 Pos = InStr(1, OldSource, ",") If Pos > 0 Then Parts(Part) = CStr(Left(OldSource, Pos)) OldSource = Mid(OldSource, Pos + 1, Len(OldSource)) End If Next Part If Right(OldSource, 1) = "," Then OldSource = Left(OldSource, Len(OldSource) - 1) Else If OldSource = "" Then Parts(2) = Left(Parts(2), Len(CStr(Parts(2))) - 1) End If Ctl.RowSource = Parts(1) & Parts(3) & Parts(2) & OldSource & Parts(4) End Sub Private Sub NewValueList(Ctl As Control) Dim OldSource As String Dim NewSource As String Dim TempStr As String Dim Part As Byte Dim Cols As Byte Dim ColLen As Double Dim Pos As Integer Dim Count As Integer If Ctl.RowSourceType <> "Value List" Then Exit Sub If Ctl.ColumnCount < 3 Then Exit Sub OldSource = Ctl.RowSource & ";" Cols = Ctl.ColumnCount Do Pos = InStr(Pos + 1, OldSource, ";") If Pos > 0 Then Count = Count + 1 Loop Until Pos = 0 If Count < Cols * 3 Then Exit Sub ColLen = Count / Cols If ColLen <> Fix(ColLen) Then Exit Sub For Part = 1 To Cols For Count = 1 To ColLen Pos = InStr(1, OldSource, ";") If Pos > 0 Then Select Case Count Case 2 TempStr = Left(OldSource, Pos) Case 3 NewSource = NewSource & Left(OldSource, Pos) & TempStr Case Else NewSource = NewSource & Left(OldSource, Pos) End Select OldSource = Mid(OldSource, Pos + 1) End If Next Count Next Part NewSource = Left(NewSource, Len(NewSource) - 1) Ctl.RowSource = NewSource Ctl.Requery End Sub Private Sub ChangeColumnOrder(eMe As Object) Dim Cols Dim Ctrl As Control Dim Ctrls As Long Dim Count As Integer On Error Resume Next If eMe.DefaultView <> 2 Then Exit Sub ReDim Cols(1 To eMe.Controls.Count) As String For Each Ctrl In eMe.Controls With Ctrl If .Section = 0 Then If .ControlType <> acLabel Then Count = Count + 1 Cols(.ColumnOrder) = .Name End If End If End With Next If Count < 2 Then Exit Sub Ctrls = Count For Count = 1 To Ctrls eMe(Cols(Count)).ColumnOrder = Ctrls - eMe(Cols(Count)).ColumnOrder - Count Next Count End Sub Sub ChangeOrientation(eMe As Object) Dim Ctl As Control Dim GrpLeft() As Integer Dim GrpWidth() As Integer Dim GrpCtl() As Control Dim Count As Byte Dim Ctrls As Byte Dim FormWidth As Integer Dim TempCaption As String Dim Test As Variant On Error Resume Next For Each Ctl In eMe.Controls With Ctl If .ControlType = acOptionGroup Then Count = Count + 1 ReDim Preserve GrpCtl(Count) ReDim Preserve GrpLeft(Count) ReDim Preserve GrpWidth(Count) Set GrpCtl(Count) = Ctl GrpLeft(Count) = .Left GrpWidth(Count) = .Width End If End With Next Ctl FormWidth = eMe.Width With eMe If Trim(.Tag) <> "" And Trim(.Caption) <> "" Then TempCaption = .Caption .Caption = .Tag .Tag = TempCaption End If End With For Each Ctl In eMe.Controls With Ctl If .ControlType <> acOptionGroup Then If .ControlType <> 124 Then .Left = FormWidth - (.Left + .Width) End If '------------------ If .ControlType = acComboBox Or _ .ControlType = acListBox Then Call NewSource(Ctl) Call NewValueList(Ctl) Select Case .ScrollBarAlign Case 1: .ScrollBarAlign = 2 Case 2: .ScrollBarAlign = 1 End Select End If '------------------ Select Case .Format Case "dd/mm/yy": .Format = "yy/mm/dd" Case "dd-mm-yy": .Format = "yy-mm-dd" Case "dd/mm/yyyy": .Format = "yyyy/mm/dd" Case "dd-mm-yyyy": .Format = "yyyy-mm-dd" Case "yy/mm/dd": .Format = "dd/mm/yy" Case "yy-mm-dd": .Format = "dd-mm-yy" Case "yyyy/mm/dd": .Format = "dd/mm/yyyy" Case "yyyy-mm-dd": .Format = "dd-mm-yyyy" End Select '------------------ Select Case .NumeralShapes Case 1: .NumeralShapes = 2 Case 2: .NumeralShapes = 1 End Select '------------------ Err.Clear Test = .Caption If Err.Number = 0 Then If Trim(.Tag) <> "" And Trim(.Caption) <> "" Then TempCaption = .Caption .Caption = .Tag .Tag = TempCaption End If End If '------------------ Select Case .TextAlign Case 1: .TextAlign = 3 Case 3: .TextAlign = 1 End Select '------------------ 'If .ControlType = acLine Then .LineSlant = -(.LineSlant + 1) 'End If '------------------ If .ControlType = acSubform Then If .Tag <> "No Change" Then Call ChangeOrientation(.Form) End If '------------------ If .ControlType = acTabCtl Then Ctrls = .Pages.Count If Ctrls > 1 Then For Count = 0 To Ctrls - 2 .Pages(Count).PageIndex = (Ctrls - 1) - .Pages(Count).PageIndex - Count Next Count End If End If End If End With Next Ctl If UBound(GrpCtl) = -1 Then GoTo ExitSub '------------------ For Count = 1 To UBound(GrpCtl) GrpCtl(Count).Move FormWidth - (GrpLeft(Count) + GrpWidth(Count)), , _ GrpWidth(Count) eMe.Width = FormWidth Next Count ExitSub: Call ChangeColumnOrder(eMe) End Sub

هل هناك مثال استاذي الفاضل

بانتظارك استاذي الكريم

الف شكر لك استاذ خليفة لقد نجح الامر جزاك الله عنا كل خير لكن هل هناك طريقة لجعل كل البرنامج تتغير لغته لان تلك الطريقة نجحت فقط على نموذج واحد ولكن لم تنجح على بقية النماذج هل من المعقول ان اضع زر تغيير اللغة في كل النماذج؟؟

السلام عليكم اخوتي الاكارم هل هناك طريقة لتغيير لغة البرنامج المصمم لدي بحيث اذا دخل مستخدم واراد ان يعمل باللغة العربية فيتحول كل البرنامج مع محتوياته الى اللغة العربية واذا اراد ان يعمل باللغة الانكليزية فيصبح البرنامج كامل باللغة الانكليزية عن طريق وضع combobox في واجهة البرنامج للاختيار

جزاكم الله اخي الكريم كل الشكر لشخصكم الطيب

السلام عليكم اخواني الاكارم الرجاء المساعدة عن كيفية اضافة سجل في زر وحذف سجل في زر وازا قمنا بحذف سجل ان يرجع الى الرقم الذي قبله اي الى السجل الذي قبله مثال عندي 8 سجلات منشأة حذفت السجل الثامن ان يرجع تلقائيا الى السجل السابع واستطيع مجددا استخدام السجل رقم 8 لاضافته وكيفية البحث والاستعراض على السجلات في اداة combo box بحيث عند استعراض كل السجلات استطيع ان اختار احد السجلات ويظهره فورا على الفورم باستخدام vba وشكرا جزيلا لكم

شكرا استاذ ابو خليل لقد نجحت التجربة كل الفضل لك @ابوخليل