ابو ياسين المشولي

فكرة ممتازة

ليت ملف تطبيقي

ليستفيد الجميع

جرب هكذا

لازم يكون في راس النمودج
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

هذا كود عامله انا يفتح الصورة اللي في المجلد اللي بنفس رقم الفاتورة
ShellExecute Me.hwnd, "open", CurrentProject.path & "\StPic" & "\" & Trim(str(nofatora)) & ".jpg", "", "", 1

StPic=المجلد
CurrentProject.path=موقع البرنامج
nofatora=رقم الموظف
.jpg= الصيغه

اعمل شرط في الجدول

تحت الرصيد اكبر من صفر

<0

اخي هذا حسب مافهمته من تصميم المنوذج

Select Case Nz(OP1, "")
    Case 1
        DoCmd.OpenReport "RepBalanceAll", acViewPreview
    Case 2
     DoCmd.OpenReport "RepBalanceAll", acPreview, , "[EDate]Between [Forms]![frmReportBalance]![Con1] And [Forms]![frmReportBalance]![Con2]"
    Case 3
        If IsNull(cbFr3) Then
            MsgBox "يجب اختيار الفرع اولا", vbCritical, "انتبه"

            Me.cbFr3.SetFocus
            Me.cbFr3.Dropdown
            Exit Sub
        Else
     DoCmd.OpenReport "RepBalanceAll", acPreview, , "[EDate]Between [Forms]![frmReportBalance]![Con1] And [Forms]![frmReportBalance]![Con2]and [Fr3Name]=[Forms]![frmReportBalance]![txtNameFr3]"
        End If
   
End Select

Pro-Acc-S7.rar

10 ساعات مضت, عمر ضاحى said:

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

معي هذا الداله

IIf([Forms]![frmReportBalance]![OP1]=2;Between [Forms]![frmReportBalance]![txtdate1] And [Forms]![frmReportBalance]![txtdate2];([TblErad]![EradDate]))

لكنها لا تعمل جيدا

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

01.rar 88.85 kB · 12 downloads

هل تقصد هكذا

01.rar

في 30‏/6‏/2022 at 19:32, ابو جودي said:

------------------------

لفد وضعت الكود على اعتبار تعدد القيم وتعدد الالوان تبعا لتعدد القيم 

بوجه عام الكود بكل بساطه 

مشاركة مع احي ابو جودي يمكنك ذكر اللون مباشرة بالاسم

Dim colorA As Long: colorA = vbRed
Dim colorB As Long: colorB = vbYellow
  With Me.txtQty
    .BackColor = (IIf(.BackColor = colorA, colorB, colorA))
  End With

 

  Dim obj As AccessObject, dbs As Object
    Set dbs = Application.CurrentData

    For Each obj In dbs.AllTables

        If Left(obj.Name, 4) <> "MSys" Then
            
            DoCmd.SetWarnings False
                DoCmd.RunSQL ("Delete * From " & obj.Name)
            DoCmd.SetWarnings True
            
        End If
        
    Next obj
    
    MsgBox "تم حذف سجلات جميع الجداول"

راجع هذا

هنا

اتفضل

On Error GoTo أمر21_Err
If MsgBox("هل تريد الحذف", vbYesNo + 48, "رسالة تنبيه") = vbYes Then

    With CodeContextObject
        On Error Resume Next
        DoCmd.GoToControl Screen.PreviousControl.Name
        Err.Clear
        If (Not .Form.NewRecord) Then
            DoCmd.RunCommand acCmdDeleteRecord
        End If
        If (.Form.NewRecord And Not .Form.Dirty) Then
            Beep
        End If
        If (.Form.NewRecord And .Form.Dirty) Then
            DoCmd.RunCommand acCmdUndo
        End If
        If (.MacroError <> 0) Then
            Beep
            MsgBox .MacroError.Description, vbOKOnly, ""
        End If
    End With

Else
MsgBox "تم الرجوع", 48, "رسالة تنبيه"
End If

أمر21_Exit:
    Exit Sub

أمر21_Err:
    MsgBox Error$
    Resume أمر21_Exit

20.rar

عمل ممتاز يعطيك الف عافية

مشاركة مع اخي ابو جودي

مجدل data يكون بجوار البرنامج

ملفات QR.rar

للاسف اخي ابا جودى

في وندوز 10 لم يعمل

في ٢١‏/٢‏/٢٠٢١ at 19:01, abouelhassan said:

بارك الله فيك اخى الغالى ظهر هذا الخطأ عند التشغيل

 

Dim Fso
dim MyPath
set fso=createObject("Scripting.fileSystemObject")
Mypath=fso.GetAbsolutePathName(".")

	With Createobject("Access.Application")
		.AutomationSecurity = 1
		.opencurrentdatabase mypath & "\هناء اسم برنامجك", , "هناء كلمه السر" 
		.usercontrol=True
	End with
او اذا كان بدون كلمه سر هكذا
Dim Fso
dim MyPath
set fso=createObject("Scripting.fileSystemObject")
Mypath=fso.GetAbsolutePathName(".")

	With Createobject("Access.Application")
		.AutomationSecurity = 1
		.opencurrentdatabase mypath & "\هناء اسم برنامجك"
		.usercontrol=True
	End with

وهنا اذا كان الملف فيه رقم سري من ااخي ابو عبدالله الحلواني

Dim Fso
dim MyPath
set fso=createObject("Scripting.fileSystemObject")
Mypath=fso.GetAbsolutePathName(".")

	With Createobject("Access.Application")
		.AutomationSecurity = 1
		.opencurrentdatabase mypath & "\Type here your program name", , "Type here the passward" 
		.usercontrol=True
	End with

19 ساعات مضت, أبو عبدالله الحلوانى said:

أخي أبا ياسين لا داعي لاستخدام CurrentDirectory  فـ Mypath تلتقط المسار الحالي للبرنامج 

نعم عندك حق

5 ساعات مضت, أبو عبدالله الحلوانى said:

مجرد اقتراح من الممكن استخدام اسكربت كهذا لفتح البرنامج بدون رسائل الأمان وبدون الحاجة لتخفيض أمان الأكسس بالكلية

الخطوات

1- تعديل اسم البرنامج داخل الاسكربت وتعديل كلمة المرور أو حذفها ان لم يكن للبرنامج كلمة مرور

2- نضع الاسكربت داخل الفولدر الحاوي للبرنامج وانشاء اختصار له علي سطح المكتب

3- نقوم بتشغيل البرنامج (البرنامج يعمل بأمان وأي ملف أكسس أخر يتم ايقافه باجراءات الأمان)

 

RunProgram1.rar 321 \u0628\u0627\u064a\u062a · 3 downloads

وهذا عندما يكون نفس المسار مافي داعي تكتب المسار فقط اسم البرنامج وكلمه المرور

Dim Fso
dim MyPath
set fso=createObject("Scripting.fileSystemObject")
Mypath=fso.GetAbsolutePathName(".")

	With Createobject("Access.Application")
		.AutomationSecurity = 1
		.opencurrentdatabase mypath & CurrentDirectory & "\program name", , "Type here the passward" 
		.usercontrol=True
	End with

منذ ساعه, amir_adam83 said:

ابو ياسين المشولي

شكرا على مرورك الكريم اخي

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

On Error Resume Next

 

نعم اخي انه خطا اعمل استعلام الحاق ثم حوله الى كود

في الكود اوقف هذا الكود

On Error Resume Next

وبيطلع لك ان كود الترحيل فيه خطاء

جرب هذا

ABcont.rar

هو عند الاشتراك يعطوك 5 رسايل او 3 للتجربه

بس تعرف بيكون غالي عليك اذا في ببلدك افضل

دخلت شفت رسايلهم 

سعر الرسالة الدولية بخمس رسائل

الان, sandanet said:

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

 

تحياتي

الشكر موصول لك اخي  سند

وماقصرت الله يحفظك

8 دقائق مضت, sandanet said:

تمام وضحت الرؤيا بارك الله فيك .. سؤال اخير وهو كم يساوي بالدولار مبلغ 1000 ريال في حال اردت الاشتراك في تلك الخدمة؟

تقريبا الف ريال سعودي يساوي 264

لانه الصرف اتوقع

3.79

8 دقائق مضت, sandanet said:

اشكرك جزيل الشكر استاذ ابو ياسين على هذا التوضيح المهم .. انا في الواقع لم اقم بالعمل على ارسال الرسائل من خلال الموقع لذلك لم ألاحظ هذه الفقرة 

سؤالي هو ماهو التقرير الذي يتم ارساله؟ فعند تجربتي للبرنامج لم الاحظ الفرق

ثانياً ماهو الخيار الموجود اسفل منها "تغيير معدل الارسال" ؟ 

استاذي sandanet

شوف الصورة في تقرير الوصول نعم وتقرير الوصول لا

اللي هي نعم يخصم رسالتين ولا رساله فقط مافي منه اي فائده

اما الخيار الثاني كمان مامنه فائده وهو يعطيك كم رساله بالدقيقه كما هو بالصورة

6 دقائق مضت, sandanet said:

وهل هذا الأمر تم توضيحه للعميل عند الاشتراك؟

نعم شوف هذه الصورة

الان, sandanet said:

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

استاذ sandanet

المشكله بسيطه فقط يبدل هذا 

& "&EnableDR=" & False & "&SentMessageID=" & False

من True الى False

اي انه لا يستلم تقرير الارسال بالتقرير يخصمو رساله

للاسف اخي محمد أبوعبدالله

لم يشتغل على وندوز10