jamal2080

مايو 5, 2023

السلام عليكم وجد فى احد المواقع كود بحث ارجوا منكم افادة فى هذا الكود

الكود الاول فى حدث البحث فى النمودج

Private Sub cmdfindrec_Click()
On Error GoTo Err_cmdfindrec_Click
    
    Set GENERAL.PRVCTRL = Screen.PreviousControl
    
    Screen.PreviousControl.SetFocus
    
    Set GENERAL.GLFRM = Me

   If GENERAL.PRVCTRL.name = "frmsolaf" Then
       '-------------------------------------------------
       Msg = "غير مسموح بالبحث فى سجل "
       Style = vbOKOnly
       Title = " "
       Dim s As Integer
       s = 10 ' عدد الثواني
       mResult = MsgBoxPause(hwnd, Msg, Title, Style, s)
       '-------------------------------------------------
    Resume Exit_cmdfindrec_Click
   End If
   
    DoCmd.OpenForm "frm_find", acNormal, , , , acDialog


Exit_cmdfindrec_Click:
   user_licence
   no_add_mod_del
     Me.cmdsaverec.Enabled = False
     Me.cmd_undo.Enabled = False
     Me.cmd_Undo_sub.Enabled = False
   
    
    Exit Sub

Err_cmdfindrec_Click:
    
    If Err.Number = 2455 Then
    
    GLFRM.Filter = ""
    GLFRM.FilterOn = False
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

    Resume Exit_cmdfindrec_Click
    End If
    
    
    Handle_Errors_ADO "", Err.Number, Err.Description
    Resume Exit_cmdfindrec_Click
    
End Sub

الكود الثانى موجود داخل نمودج البحث .... لان نمودج البحث مثل نمودج البحث افترضى الاكسس

Option Compare Database
Dim Anim As clsFormAnimate
Private Sub cmd_exit_Click()
On Error GoTo Err_EXIT_Click

    DoCmd.Close

Exit_EXIT_Click:
    Exit Sub

Err_EXIT_Click:
   Handle_Errors_ADO "", Err.Number, Err.Description
    
    Resume Exit_EXIT_Click
End Sub


Private Sub cmd_search_Click()
Dim str As String
Dim str_2 As String
Dim mth As Integer
Dim X
 
  If GENERAL.PRVCTRL.ControlType <> acComboBox Then
   
    
             If Me.FLDSRH <> "" Then
     
                                Select Case Me.srhtyp.Value
        
                                  Case "1"
                                            str = Me.FLDSRH & " = " & """" & Me.str & """"
                                            str_2 = Me.FLDSRH & " = " & Me.str
               
                                  Case "2"
                                            str = Me.FLDSRH & " LIKE " & """" & Me.str & "*"""
                                  Case "3"
                                            str = Me.FLDSRH & " LIKE " & """*" & Me.str & "*"""
                                  Case "4"
                                            str = Me.FLDSRH & " LIKE " & """*" & Me.str & """"
                                End Select
    
                 Else
                           str = "1=1"
             End If
    
    
  Else
    
                 X = GENERAL.PRVCTRL.RowSource

                 X = GENERAL.PRVCTRL.Column(1)

                If Me.FLDSRH <> "" Then
     
                           Select Case Me.srhtyp.Value
        
                                  Case "1"
                                         str = Me.FLDSRH & " = " & """" & Me.str & """"
                                         str_2 = Me.FLDSRH & " = " & Me.str
                                  Case "2"
                                         str = Me.FLDSRH & " LIKE " & """" & Me.str & "*"""
                                  Case "3"
                                         str = Me.FLDSRH & " LIKE " & """*" & Me.str & "*"""
                                  Case "4"
                                         str = Me.FLDSRH & " LIKE " & """*" & Me.str & """"
                           End Select
    
                  Else
                         str = "1=1"
                 End If


   End If

If IsNull(Me.srhtyp.Value) Then
  mth = 0
Else
  mth = Me.srhtyp.Value
End If
DO_FIND str, str_2, mth
Rem DoCmd.Close acForm, "frm_find", acSaveYes
End Sub
Private Sub Form_Load()
Dim a As Integer
 a = Int((28 * Rnd) + 1)
 
Select Case a
       Case 1
       Me.Detail.BackColor = 14403521
      
      Case 2
       Me.Detail.BackColor = 16421253
      Case 3
       Me.Detail.BackColor = 16492959
      Case 4
       Me.Detail.BackColor = 16561323
      Case 5
       Me.Detail.BackColor = 16630973
      Case 6
       Me.Detail.BackColor = 16700367
      Case 7
       Me.Detail.BackColor = 16704224
      Case 8
       Me.Detail.BackColor = 16774130
      Case 9
       Me.Detail.BackColor = 10681796
      Case 10
       Me.Detail.BackColor = 15728569
      Case 11
       Me.Detail.BackColor = 15597488
      Case 12
       Me.Detail.BackColor = 14745463
      Case 13
       Me.Detail.BackColor = 12451474
      Case 14
       Me.Detail.BackColor = 10223575
      Case 15
       Me.Detail.BackColor = 16772014
      Case 16
       Me.Detail.BackColor = 16699135
      Case 17
       Me.Detail.BackColor = 9105153
      Case 18
       Me.Detail.BackColor = 14672127
      Case 19
       Me.Detail.BackColor = 11061759
      Case 20
       Me.Detail.BackColor = 10414590
      Case 21
       Me.Detail.BackColor = 7994838
      Case 22
       Me.Detail.BackColor = 8781491
      Case 23
       Me.Detail.BackColor = 14089782
      Case 24
       Me.Detail.BackColor = 16705136
      Case 25
       Me.Detail.BackColor = 16500091
      Case 26
       Me.Detail.BackColor = 16686226
      Case 27
       Me.Detail.BackColor = 14655727
      Case 28
       Me.Detail.BackColor = 10390517
  
  End Select
   
    FLDSRH = GENERAL.PRVCTRL.name
End Sub
Private Sub Form_Open(Cancel As Integer)
Set Anim = New clsFormAnimate
   Set Anim.AnimationForm = Me
   Anim.FormHeight = 2500
   Anim.FormWidth = 4900
   Anim.FormTop = 1000
   Anim.FormLeft = 100
   ' Comment out line below if you
   ' want Animation when closing the Form.
   Anim.NoCloseAnimation = True
   ' Uncomment if you do NOT want
   ' Animation when the Form opens
   'Anim.NoOpenAnimation = True
 
End Sub

وشكرا لكم

أبريل 29, 2023

بعد السلام

ارجوا مساعدها فى تعديل اكود شاشة تسجيل بيانات المركبات من حيث

- حفظ الصورة

- ازرار حركات النمودج

ولكم منا جزيل الشكر والتقدير

texstx.rar

أبريل 11, 2023

السلام عليكم ورحمة الله وبركاتة

اريد ربط خانة اختيار مع جدول فى حالة الطلبية

checkbox.rar

مارس 31, 2023

تظهر لي رسالة خطا عند فتح النموذج في access وحسب الصورة المبينة

مارس 30, 2023

السلام عليكم ورحمة الله وبركاتة

اريد من اعضاء المنتد الكرام التعديل وملاحظات على هذه البرنامج

Database2.rar

مارس 25, 2023

السلام عليكم ورحمة الله وبركاته

عندى نمودج فاتورة استلام يوجد بة مربع خيارين نقدأ وصك .

1 - نقدا من 500 دنيار واقل

2 - صك اعلى من 500 دنيار

اريد كود حدث Untitled.png.b911a9d8568713c0d4dc3563af2e3ec5.png

مارس 23, 2023

وضع الكود فى حدث بعد التحديث

مارس 23, 2023

هذا الكود يمكن ان نضعة فى مريع نص منظم

="RD" & [report_No] & Format([txt5];"mm" & Format([txt5];"yy"))

كل عام وجميع بالف خير بحلول شهر رمضان الكريم

مارس 21, 2023

السلام عليكم ورحمة الله وبركاتة

بنسبة التقرير الاستلام المواد جزئية يعد نمودج عدد البنود المستلمة فعالية من حيث الكمية المطلوبة والكمية المستلمة . رقم التقرير الاستلام يخذ اكثر من رقم ولكن رقم الطلبية ورقم طلب التوريد ثابت.

مارس 19, 2023

جزاك الله خيرا اخي موسى

مارس 19, 2023

هذا النمودج تقرير الاستلام

1 - استلام مواد مخزنية محلى

2 - استلام مواد مخزنية خارجية

3 - استلام مواد عشوائى

وكل النمادج يوجد بة استلام جرئية وكلية

مارس 19, 2023

كل عام وانت بخير رمضان كريم

اريد استفسار عن نمودج تقرير استلام مواد . عندى استلام مواد من المورد يتم استلام كلى او جزئى اى جزئى يحمل نفس رقم طلب التوريد ورقم الطلبية .

1 - هل يمكن استلام على عدات تقرير استلام .

وشكرا على حسن تعاونكم معنا

مارس 8, 2023

كيفية جعل صفحة عرض مناسبة مع جميع شاشات الحواسيب

ضع هاذا التعريف فوق الفروم لود

Dim ProportionsArray() As CtrlProportions

وفي الفروم لود ضع هاذا الكود

  Informload()

  End Sub
  Private Structure CtrlProportions
      Dim HeightProportions As Single
      Dim WidthProportions As Single
      Dim TopProportions As Single
      Dim LeftProportions As Single
  End Structure
  Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize

      Resizeform()

  End Sub


  Sub Informload()

      On Error Resume Next

      Application.DoEvents()

      ReDim ProportionsArray(0 To Controls.Count - 1)

      For I As Integer = 0 To Controls.Count - 1

          With ProportionsArray(I)
              .HeightProportions = Controls(I).Height / Height
              .WidthProportions = Controls(I).Width / Width
              .TopProportions = Controls(I).Top / Height
              .LeftProportions = Controls(I).Left / Width

          End With
      Next

  End Sub

  Public Sub Resizeform()

      On Error Resume Next

      For I As Integer = 0 To Controls.Count - 1

          Controls(I).Left = ProportionsArray(I).LeftProportions * Me.Width
          Controls(I).Top = ProportionsArray(I).TopProportions * Me.Height
          Controls(I).Width = ProportionsArray(I).WidthProportions * Me.Width
          Controls(I).Height = ProportionsArray(I).HeightProportions * Me.Height
      Next

مارس 6, 2023

بعد السلام ...

انشاء نمودج رئيسى مل الشاشة استعمل كود DoCmd.Maximize

يفتح النمودج على شاشة التى استعمالة فى البيت 100% وحجمة 19 انش .

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

هل هناك طريقة معين .

لكم منى كل احترام وتقدير

مارس 1, 2023

السلام عليكم ورحمة الله وبركاتة

ارجاء المساعد فى طريقة بحث عن طريقة نمودج اخر

Private Sub cmdSearch_Click()
If Len(Me.txtSearch & "") = 0 Then
MsgBox "رجاء ادخال رقم للبحث عنه"

ElseIf DCount("*", "frm_RD", "report_No =" & Me.txtSearch) = 0 Then
MsgBox "الرقم غير موجود"

Else
Me.Recordset.FindFirst "report_No=" & Me.txtSearch
End If

Me.txtSearch.SetFocus
Me.txtSearch = ""
End Sub

فبراير 27, 2023

اخى لا اريد الرسالة الفترضي الاكسيس تظهر اريد اظهر رسالة تنبية خاص بى الكومبوبوكس خاص بالموردين وليس تاريخ

فبراير 26, 2023

السلام عليكم ورحمة الله وبركاتة

عندى الكومبوبوكس اريد عندى ادخال قيمة غير موجودة تظهر رسائل تنبية

رسائل تنبية.rar

فبراير 23, 2023

هو مدفعة لا تعمل تحديث سوف يعحابك مع كراك ..... هذه هدية متوضع

فبراير 23, 2023

اخى ابوخليل

وضع الكود نفس طريقة مانفع

فبراير 23, 2023

https://filecr.com/windows/stellar-repair-for-access-pro/?id=322778273242هذا البرنامج هدية الى منتدى أوفيسنا

فبراير 23, 2023

السلام عليكم ورحمة الله وبركاتة

انا عند رقم تكون من رمز + رقم فاتورة + شهر + سنة

RD 131129 02 23

ارجوا تعديل الكود

Sub UpdateRDnum()
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("receiptRD", dbOpenDynaset)

With rs
Do Until .EOF
If IsNull(!RDnum) Or !RDnum = "" Then
.Edit
!RDnum = "RD" & !report_No & Month(Date) & year(Date)
.Update
End If
.MoveNext
Loop
End With

rs.Close
Set rs = Nothing
Set db = Nothing

End Sub

فبراير 18, 2023

يومك طيب اخى المهندس قاسم

اريد احفظ البرنامج 2013 تخروخ رسائل خطاء

ملف يشتغل على اوفيس 2016 ابس

فبراير 18, 2023

سوف نقوم تغير على 2013

فبراير 17, 2023

السلام عليكم ورحمة الله وبركاته

انشاء علاقات بين الجدول ولكن فراغ الجدول من البيانات كثيرة عندم اريد استرجاع البيانات لا يقبل استرجاعها -

هل توجد طريقة استرجاع البيانات دفعة وحدة فرزها من المكرر
ارفاق لكم مثل طريقة الربط الجدول

اسف نسيت مثل

Database13.rar

فبراير 17, 2023

السلام عليكيم ورحمة الله وبركاته

عندى برنامج طلبات استلام مواد اريد انا اعمل اعتماد او حفظ نهاية لطلب لايقبل التعديل او حذف

انا ليس عندى فكره معين لكم الامر

1080.rar

تسجيل الدخول

المنتدى

مكتبة الموقع

معرض الصور

المدونات

الوسائط المتعددة

مشاركات المكتوبه بواسطه jamal2080

Important Information