نجوم المشاركات
Popular Content
Showing content with the highest reputation on 09/05/18 in مشاركات
-
السلام عليكم: تفضل هذا الكود و معه مثال: Private Const HWND_BROADCAST = &HFFFF& Private Const WM_FONTCHANGE = &H1D Private Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Sub أمر0_Click() Dim res As Long ' add the font res = AddFontResource(CurrentProject.Path & "\DS-DIGI.ttf") If res > 0 Then ' alert all windows that a font was added SendMessage HWND_BROADCAST, WM_FONTCHANGE, 0, 0 MsgBox "لقد تم إضافة الخط بنجاح" End If End Sub إضافة خط للونداوز.rar4 points
-
والطريقة المختصرة اذا كان هناك محرر فيجوال تابع النموذج مفتوحة ( اي اذا فتحت من قبل محرر فيجوال تابع للنموذج ) Form_FrmName.ControlName.setfocus3 points
-
وعليكم السلام الطريقة اللي تشتغل لكل الاحتمالات هي: Main Form Name = اسم النموذج الرئيسي Sub Form Name = اسم النموذج الفرعي Control Name = اسم الكائن في النموذج اذا كان في النموذج الرئيسي Forms![Main Form Name].setfocus Forms![Main Form Name]![Control Name].setfocus اذا كان في النموذج الفرعي Forms![Main Form Name].setfocus Forms![Main Form Name]![Sub Form Name].setfocus Forms![Main Form Name]![Sub Form Name]![Control Name].setfocus جعفر3 points
-
2 points
-
السلام عليكم تفضل هذا مثال لإخفاء النماذج لكن تستطيع إظهارها من شريط التمرير بتغيير الخصائص إخفاء الجداول و النماذج.rar2 points
-
السلام عليكم كل المشكلة يرجع لكود الحذف فقط انا عملت تغيير بسيط في الكود اي غيرت من هذا Me.B1 = "" الى هذا لكل مربعات Me.B1 = Null لان في كود الاضافة انك تستخدم كلمة IsNull اليك المرفق بعد تعديل New Microsoft Access Database - Copy (2).rar2 points
-
استخدم هكذا =Nz(DSum("[item_preis]";"tabol_sdad_mord";"[fatora_no]=" & [fatora_no] & "And [dete_add2] Between [snddate] And [snddate2]");"0")2 points
-
السلام عليكم استعمل الأمر me.txt1.setfocus txt1 هو اسم مربع النص الذي تريد الإنتقال إليه2 points
-
فقط اكتب للاكسل ما تريد ان تبحث عنه واضغط الزر Run حرب هذا الملف Saerch_expressions.xlsm1 point
-
السلام عليكم ورحمه الله وبركاته اخواني الكرام اين الخطاء في هذة الدالة مع العلم fatora_noهي رقم وليس نص =Nz(DSum("[item_preis]";"tabol_sdad_mord";"[fatora_no]=" & [fatora_no] And [dete_add2] Between [snddate] And [snddate2] & "");"0")1 point
-
ارجو المساعدة فى برنامج قمت بانزاله من على النت 1- عدم تكرار اسم الموظف عند اضافة موظف موجود بالفعل 2- عدم تداخل الاجازة او تكرار التاريخ لنفس الموظف شكرا لمساعدتكم برنامج اجازات التكليف بالاعياد الأصل.mdb1 point
-
الف مليون شكر للبارع العبقرى المحترم ali mohamed ali انا جربت الملف الاول فقط وهو رائع بصراحة ولكن هناك بعض الملاحظات سوف ادرجها لحضرتك فى المشاركة التالية استاذي المحترم وغدا سوف اجرب الملف الاخر لان الاكسيل على جهاز المستشفى وهناك ليس به نت1 point
-
وعليكم السلام اخي واهلا وسهلا بك في المنتدى اذا كنت تستعمل الاكسس 2007 فما فوق ، فتستطيع ان تجرب: اعمل الحقل في الجدول بنوع مذكرة ، وفي اعدادات الحقل ، اختر تنسيق : Rich Text ، واعمل نفس الشيء في الحقل في التقرير ، ثم جرب ما قمت به. جعفر1 point
-
السلام عليكم بعد اذن استاذ جعفر واسف للتاخير في الرد على الزميل @محمد قاسم 12 الملف مجرد مثال لتطبيق الكود الخاص باستاذي الفاضل جعفر بارك الله له وفيه names.accdb1 point
-
1 point
-
1 point
-
بعد اذن اخي علي هذا الملف الكود Option Explicit Function Replace_A_Z(st$) As String Dim k%: k = Len(st) Dim i% Dim New_str$ For i = 1 To k If Mid(st, i, 1) Like "[A-Z]" Then New_str = New_str & Asc(Mid(st, i, 1)) - 64 End If Next Replace_A_Z = IIf(New_str = vbNullString, "N/A", New_str) End Function Letter_to Number.xlsm1 point
-
وانا كذلك اتفق مع اخي الاستاذ شفان اذا كان كُلٌ ولابد ، اعمل قاعدة بيانات جديدة ، استورد اليها كائنات البرنامج القديم ، ثم اعمل جعفر1 point
-
اخيShivan Rekany انا عارف انه بيحسب هكذ انا ما اريده انه حقل dete_add2 هو تاريخ الخصم والحقل dete_add هو تاريخ مدفوع فانا اريد المدفوع في تاريخ الخصم اي خلال فترة الخصم لنفس الفاتورة لذلك حبيت اعرف كيف اضيف شرط الفاتورة1 point
-
السلام عليكم اجريت بعض التعديلات على الكود ، فرجاء حذف الكود القديم واستعمال هذا الكود Private Sub cmdAdd_Click() Dim strFilter As String Dim lngflags As Long Dim varFileName As Variant ' strFilter = "All Files (*.*)" & vbNullChar & "*.*" _ ' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*" strFilter = "jpg" & vbNullChar & "*.jpg" _ & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*" lngflags = tscFNPathMustExist Or tscFNFileMustExist _ Or tscFNHideReadOnly varFileName = tsGetFileFromUser( _ fOpenFile:=True, _ strFilter:=strFilter, _ rlngflags:=lngflags, _ strDialogTitle:=" الرجاء اختيار ملف ") If IsNull(varFileName) Then Me.ImagePath.Visible = False Me.ImageFrame.Visible = False Me.ImageFrame.Picture = "" Else Me![ImagePath] = varFileName Me.ImagePath.Visible = True Me.ImageFrame.Visible = True Me.ImageFrame.Picture = Me.ImagePath End If cmdAdd_End: On Error GoTo 0 Exit Sub cmdAdd_Err: Beep MsgBox Err.Description, , "Error: " & Err.Number _ & " in file" Resume cmdAdd_End DoCmd.Requery End Sub Private Sub Form_AfterUpdate() On Error Resume Next Me![ImageFrame].Picture = Me![ImagePath] End Sub Private Sub Form_Current() On Error GoTo err_Form_Current 'On Error Resume Next Me![ImageFrame].Picture = Me![ImagePath] Exit Sub err_Form_Current: If Err.Number = 2220 Or Err.Number = 13 Then Me.ImagePath.Visible = False Me.ImageFrame.Visible = False Me.ImageFrame.Picture = "" Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر 968.AddPhoto.mdb.zip1 point
-
اهلا وسهلا حضرتك تريد ان تعرف مبلغ المدفوع مثلا بين تاريخين ؟ هذا صحيح ؟ الكود السابق بيعمل ما تريد لكن بها شرط اضافي وهو رقم الفاتورة اي يجب ان تكتب رقم الفاتورة و من التاريخ الى التاريخ حتى يعطيك النتيجة لذلك حسب فهمي تريد بين تاريخين و الرقم الفاتورة هو شيء زيادة لذلك احذف ذلك الشرط و خليه بين تاريخين فقط هكذا =Nz(DSum("[item_preis]";"tabol_sdad_mord";"[dete_add2] Between [Forms]![formm7]![snddate] And [Forms]![formm7]![snddate2]");0) غير التواريخ الى شهر 5 مثلا ستجد انه بيحسب حقا Database161.accdb1 point
-
حاليا الله أعلم لم تصادفني طريقة أخرى للإخفاء1 point
-
1 point
-
1 point
-
1 point
-
1 point
-
استاذ شفان جربت هذا السطر ولكن عند الضغط على زر انتر يعطي سطر جديد دون الانتقال الى مربع النص ؟؟ هل نقوم بتغير موضع الحدث مع كل الشكر1 point
-
1 point
-
اعتذر منك لاني ما ردين حتى وصلت النتيجة انا كان مشغول بعمل قائمة مصغرة على التقارير والحمد لله في الاخير وصلت للمطلوب1 point
-
تسلم اخي Shivan Rekany اتعبتك معي وكانت النتيجه هي خطاء مني في تاريخ الادخال والكود المطلوب هو هذا =Nz(DSum("[item_preis]";"tabol_sdad_mord";"[tabol_sdad_mord]![fatora_no]=[fatora_no]" & "And [dete_add2] Between[snddate] And [snddate2]");0)1 point
-
1 point
-
تفضل اخى الكريم قمت بعمل ملف لك من طريقتين الطريقة الأولى فى الصفحة الأولى __أما الطريقة الثانية ففى الورقة الثانية اختر منهما ما تريده ويناسبك ,بارك الله فيك تحديث محتوى قائمة منسدلة تلقائيا.xlsm1 point
-
اسف كيف ما وجدت الجدول والله يعلم اتفضل استخدم هذا =Nz(DSum("[item_preis]";"tabol_sdad_mord";"[tabol_sdad_mord]![fatora_no]=[nofatora]" & "And [dete_add2] Between [Forms]![formm7]![snddate] And [Forms]![formm7]![snddate2]");0) واليك نموذجك بعد تعديل Database161.accdb1 point
-
1 point
-
1 point
-
عند تحميل ملفك هل انت قمت بحذف الملف ؟ https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=1470031 point
-
للاسف يوجدخطاء اخي Shivan Rekany اليك المثال هذا مثال الداله في خانه المبلغ المدفوع Database161.accdb1 point
-
1 point
-
1 point
-
1 point
-
لدينا جدول يحتوي على اسماء التلاميذ مع علاماتهم بشكل عامودي المطلوب تحويله الى جدول مطاطي مع جمع العلامات الملف الرفق بوضح كل شيء Tanspose_notes.xlsm1 point
-
1 point
-
لابد من إرفاق ملف بالمطلوب وتحديد الخلية التي تريد زيادتها أو نقصانها زر زيادة ونقصان.xlsx.xls1 point
-
يعطيك العافية هذه قوالب تقدر تنزلها مباشرة من خلال النقر على جديد وسترى العديد من القوالب ::بالتوفيق::1 point
-
السلام عليكم هذه طريقة خفيفة عملتها ، بحقل واحد ، ونستخدم فيه الخط بسطرين . . . بهذا الكود: Option Compare Database Dim i As Integer Dim A As String Private Sub Form_Open(Cancel As Integer) i = 0 Me.pr = "سيبدأ التحميل ..." End Sub Private Sub Form_Timer() 'A = A & ChrW(&H2588) 'Big Block 'A = A & Chr(124) '| A = A & ChrW(&H2590) Me.lbl_Meter.Caption = A Me.pr = "تقدم مؤشر التحقق " & i & "%" i = i + 1 If i = 100 Then Me.TimerInterval = 0 DoCmd.Close acForm, Me.Name End If End Sub . وهناك بديل آخر في الكود بدل 'A = A & ChrW(&H2588) 'Big Block 'A = A & Chr(124) '| A = A & ChrW(&H2590) اعمل A = A & ChrW(&H2588) 'Big Block 'A = A & Chr(124) '| 'A = A & ChrW(&H2590) . لتحصل على . . جعفر 888.مؤشر تحميل.mdb.zip1 point
-
بسم الله الرحمن الرحيم السلام عليكم اقدم هذا البرنامج البسيط برنامج : شئون العاملين (التربية والتعليم ) وهوا يهتم بكل ما يخص العاملين بالتربية والتعليم ووحدة التدريب بالمدرسة والبرنامج تم بمساعدة الاساتذة الكبار فى هذا المنتدى الجميل والذى لا ننكر ابدا فضل اساتذته الكبار بارك الله فيهم --------------------------------------- والبرنامج قابل للاضافة والتعديل فى مخرجاته وارجوا من الاساتذة فحص البرنامج وتحديد ان كان به اخطاء ام لا وفى النهاية تحية حب وتقدير الى جميع اعضاء هذا الصرح الجميل شئون العاملين.rar1 point
-
أخي الحبيب محمد صالح جرب الرقم 101000 جرب هذا الملف Tafket UDF Function.rar1 point
-
السلام عليكم الاخ الكريم / الصّارم اعتقد ان التالي به طلبك تماماً ولكن عذرا للاطالة فالموضوع ليس موضوعي ولكنه للقدير العبقري الاستاذ القدير / جعفر طرباق .... جزاه الله خيرا بعنوان ((( كيف نجعل الملف ينتحر و يحدف نفسه من الجهاز تلقائيا ! )))) ولكني احببت ان انقله كما هو ليستفيد منه الجميع بكل طرقه واشكاله ============================================= الكود ادناه يفعل ذلك من داحل الملف نفسه و يمكن ربطه مثلا بالحدث Workbook_BeforeClose و مسح الملف تلقائيا و نهائيا و من دون اشعار المستخدم. SuicidalWorkbook.rar Option Explicit Private Const MSG_TITLE As String = "Deleting Current Workbook ..." Private Const MSG_TEXT As String = _ "You are about to permanently delete the current workbook located in :" Sub Kill_Myself() Dim lUserDecision As Long Dim sMsg As String On Error Resume Next sMsg = "Attention !" & vbNewLine & vbNewLine sMsg = sMsg & MSG_TEXT & vbNewLine sMsg = sMsg & "'" & ThisWorkbook.FullName & "'" & vbNewLine sMsg = sMsg & "from Disk!!" & vbNewLine & vbNewLine sMsg = sMsg & "Go ahead ?" & vbNewLine & vbNewLine Beep lUserDecision = _ MsgBox(sMsg, vbExclamation + vbYesNo, MSG_TITLE) With ThisWorkbook If lUserDecision = vbYes Then .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End If End With End Sub ====================================================== الكود التالي يحدف الملف بعد شهر واحد من اول استعماله تلقائيا و بدون اشعار المستخدم ! ضع الكود في ThisWorkbook Module Option Explicit Private Sub Workbook_Open() Dim lInitialDate As Long On Error Resume Next lInitialDate = Evaluate("InitialDate") If Err.Number = 13 Then Me.Names.Add "InitialDate", Date, False Me.Save End If If Date > Evaluate("InitialDate") + 30 Then Kill_Myself End Sub Private Sub Kill_Myself() .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End Sub ينصح اقفال الكود بباسوورد لمنع المستخدم من رؤية او حدف الكود. ================================================================ الكود التالي يحدف الملف بعد 3 الستعمالات تلقائيا و بدون اشعار المستخدم ! ضع الكود في ThisWorkbook Module Option Explicit Private Const MAX_USES As Long = 3 Private Sub Workbook_Open() Dim lNumberOfUses As Long On Error Resume Next lNumberOfUses = Evaluate("NumberOfUses") If Err.Number = 13 Then Me.Names.Add "NumberOfUses", 1, False Me.Save Exit Sub End If Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False Me.Save If Evaluate("NumberOfUses") > MAX_USES Then Kill_Myself End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub ينصح اقفال الكود بباسوورد لمنع المستخدم من رؤية او حدف الكود ========================================================= الكود التالي يحذف الملف بعد دقيقة واحدة من فتحه : (ضع الكود في ThisWorkbook Module) Option Explicit Private Const TIMEOUT As Long = 1 Private Sub Workbook_Open() Application.OnTime _ Now + TimeSerial(0, TIMEOUT, 0), Me.CodeName & ".Kill_Myself" End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub ===================================================== حذف الملف ولكن باشعار المستخدم بذلك !!!! للتمكن من اشعار المستخدم و في نفس الوقت منعه تماما من اجهاض عملية حذف الملف , اقترح الكود التالي حيث يتم اشعار المستخدم بعد حذف الملف و ليس قبل : (الملف يحذف نفسه تلقائيا بعد 3 استعمالات و يشعر المستخدم بعد الحذف) Option Explicit Private Const MAX_USES As Long = 3 Private Sub Workbook_Open() Dim lNumberOfUses As Long On Error Resume Next lNumberOfUses = Evaluate("NumberOfUses") If Err.Number = 13 Then Me.Names.Add "NumberOfUses", 1, False Me.Save Exit Sub End If Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False Me.Save If Evaluate("NumberOfUses") > MAX_USES Then Call NotifyUser Call Kill_Myself End If End Sub Private Sub NotifyUser() Dim sVbsFile As String sVbsFile = Environ("Temp") & "\VBS_MSG.vbs" Open sVbsFile For Output As #1 Print #1, "Dim Wb" Print #1, "On Error Resume Next" Print #1, _ "set wb=Getobject(" & Chr(34) & Me.FullName & Chr(34) & ")" Print #1, _ "MSG= ""You have exceeded the Maximum Number of uses of this file."" & vbnewline & vbnewline" Print #1, _ "MSG= msg & ""The file has been permanently deleted from your Drive !""" Print #1, "Do" Print #1, "Loop until wb.name=""""" Print #1, "WScript.Echo MSG" Close #1 Call Shell("WScript.exe " & sVbsFile) End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub وارجو من الله ان يجعل فيها افادة ... وادعو للاستاذ القدير العملاق / جعفر ... جزاه الله خيرا جزاكم الله خيرا1 point
-
إخواني الأعزاء نظراً لتزايد الحاجة إلى استعمال أدوات أقرب ما تكون إلى ثابتة للتحكم في مسار البرامج الخاصة بالأكسس وخاصة التجارية منها .. لذلك افردت جزء من اهتمامي لتطوير أدوات إدارية خاصة بي للتحكم في جميع برامجي بها .. وقد أرفقت هذا المثال في مشاركة خاصة بالحماية ولكن من الحكمة فصلها حتى تكون مرجع مناسب للبحث عن مثل هذه الأدوات . المثال الجامع للأدوات الإدارية 1- ربط البيانات 2- النسخ الاحتياطي 3- توجيه المسار لنسخة سابقة 4- حماية البرنامج من النسخ 5- صلاحيات المستخدمين 6- نسخ المراجع وإضافتها 7- إخفاء الجداول 8- معلومات النظام 9- وضع صورة في الخلفية مع الأخذ في الاعتبار أنني بدلت وغيرت بعض الأشياء وتم تبسيط بعض الأمور حتى لا تتعارض مع برامجي المنشورة وخاصة أنها خاضعة لشركة تجارية . ونظراً لضيق الوقت سأقوم بتفسير بعرض الأدوات باختصار شديد الدخول اسم المستخدم : 1 كلمة المرور : 1 1- ربط البيانات : عند فتح البرنامج يعمل الماكرو التنفيذي على فتح شاشة بدء التشغيل وكذلك نموذج الربط التلقائي وفي حالة فقد الرابط تخرج شاشة الربط التلقائي لتحديد المسار بالنقر المزدوج داخل المسار . 2- النسخ الاحتياطي يكون لقاعدة البيانات المرتبطة فقط أي للجداول فقط بنفس تاريخ يوم النسخ 3- توجيه المسار لنسخة أخرى شبيه بالربط التلقائي ولكن يستخدم لربط نسخة سابقة أو تالية 4- حماية البرنامج من النسخ تستخدم نفس الأسلوب الذي أشرت إليه في مشاركة الخاصة بالحماية للأخت زهرة مع ملاحظة وضع الكود التالي في حدث عند الفتح للنماذج الهامة التي نريد بدء الحماية عليه DoCmd.OpenForm "serial" من قائمة أدوات – تسجيل نسخة شرعية – استخدم المعادلة الأتية الرقم العلوي + 12305+( مدة التشغيل إما 15 يوم أو 30 أو 90أو 366 أو 1000 أو 10000 يوم ) الناتج يضرب × 2 والناتج يطرح منه 9999999 ومن السهل معرفة المعادلة من داخل الكود 5- صلاحيات المستخدمين تستخدم أسلوب اقرب ما يكون لأسلوب ابن مسقط مع مهند عبادي وقد قمت ببنائه بالمشاورة مع أبو عبد الله ولكن به بعض الاختلافات الجوهرية عن ما سبق الإشارة إليه == تم تقسم الصلاحيات إلى مسئول له جميع الصلاحيات == مستخدم يقوم المسئول بمنحه الصلاحيات == يمكن إنشاء أكثر من مسئول وتم التقسيم السابق لمنح المرونة للمسئول في منح الصلاحيات وتفويضها إن احتاج الأمر . == الجدول AdForToUse يستخدم لتحديد النماذج التي سيتم تركيب صلاحية لها ( ليس كل النماذج نرغب في وضع صلاحية عليها أو عرضها في شاشة منح الصلاحيات ) مع وضع اسم النموذج أو وظيفته باللغة العربية ليتمكن مسئول النظام من فهم كيفية منح صلاحية لمستخدم لأن استخدام أسماء النماذج كما هي لا يفيد إذا تم توزيع البرنامج وخاصة إذا كانت باللغة الأجنبية . == في نفس الجدول يجب تحديد مستوى النموذج من حيث الصلاحية a.b.c.g - المستوى a النماذج العامة - اختبار ( فتح ، تعديل ، حذف ، إضافة ) - المستوى b النماذج الفرعية - اختبار ( تعديل ، حذف ، إضافة ) - المستوى c النماذج الخاصة بالمسئول فقط - اختبار ( فتح فقط )لمسئول فقط - المستوى g النماذج التي يتم استدعاء التقارير منها - اختبار ( فتح فقط ) == في حدث عند الفتح يتم وضع الكود التالي فقط دون وضع أي أدوات أخرى على النموذج ... فقط هذا الكود .... Call allaw([Form]) أما باقي الأدوات فسأترك لكم استكشافها . وسيعجبكم كثيراً بإذن الله أداة إخفاء الجداول أيضاً أو التنويه على أن ما سبق ليس مطلقاً ولكنه خاضع للتطوير باستمرار مثل تشفير الصلاحيات والاستغناء عن الاستعلام في الصلاحيات وتطوير الحماية لتكون أكثر مرونة ولكن لن أستطيع أرفاق إلا ما سبق للأمانة العلمية . ===== في حالة وجود أي خطأ فني اعذروني للسرعة . مع خالص تحياتي رضا عقيل GeneralTols.rar1 point
-
ماكرو AutoExec هو ماكرو يقوم بتنفيذ مهام نحددها له فور تشغيل قاعدة البيانات لعمل ذلك اتبع الخطوات التاليه: 1 - قم بانشاء ماكرو جديد 2 - قم بوضع الأوامر الذي تريد ان تعمل من تلقاء نفسها فور تشغيل قاعدة البيانات وليكن فتح فورم للترحيب 3 - قم بعمل حفظ للماكرو وقم بتسميته بـ AutoExec 4 - قم بإغلاق قاعدة البيانات ثم قم بفتحها مره اخرى .. تجد بمجرد فتح قاعدة البيانات فورمة الترحيب ظهرت من تلقاء نفسها1 point