صالح حمادي

السلام عليكم
تفضل الكود التالي يقوم بطباعة الصورة مباشرة بدون عرضها في تقرير
Dim imgPath As String Dim app As Object ' تحديد مسار الصورة imgPath = CurrentProject.Path & "\Pictures\" & Me.nn & ".jpg" Set app = CreateObject("Shell.Application") ' فتح الصورة في عارض الصور الخاص بالأوفيس app.Open imgPath ' طباعة الصورة Dim objShell As Object Set objShell = CreateObject("Shell.Application") objShell.Namespace(0).ParseName(imgPath).InvokeVerbEx ("print") Set app = Nothing Set objShell = Nothing  
print picture.rar

السلام عليكم
استعمل هذا الكود في حدث عند فقد التركيز:
Me.code = Replace(Me.code, "-", "") و هذا الكود لإستبدال الشارطة بــــ(/):
Me.code = Replace(Me.code, "-", "/") و هذا الكود لإستبدالها بــمسافة:
Me.code = Replace(Me.code, "-", " ")  

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

عرض رسالة على شريط المهام.accdb

السلام عليكم و رحمة الله تعالى و بركاته
استخدم الكود التالي سوف يعطيك أسماء جميع الأزرار
Dim frm As Form Dim fc As Control Set frm = Me For Each fc In frm.Controls If fc.ControlType = 104 Then MsgBox (fc.Name) End If Next fc Set frm = Nothing  

الموضوع جاهز أستاذ جعفر عليك بالذهاب للموضوع و الإطلاع على هذه الخاصية
 

حاول تستخدم طريقة البحث قبل وضع أي موضوع
فهذا المنتدى مليء بهذا الموضوع منها
 

السلام عليكم
يجب عليك إضافة الكود Me.Refresh
في حدث بعد التحديث للقائمة المنسدلة الخاصة بإسم الإبتدائية
 

أولا يجب إضافة تعديل بسيط لدالتك لتصبح بهذا الشكل:
Function sedqtr(mott As String) Dim se As String se = "" For i = 1 To Len(mott) se = se & Format(Asc(Mid(mott, i, 1)), "000") + Int(100 / 15) Next sedqtr = se End Function الدالة المعاكسة لها تكون كالتالي:
Function sedqtr(mott As String) Dim se As String se = "" For i = 1 To Len(mott) Step 3 se = se & Chr(Val(Mid(mott, i, 3)) - Int(100 / 15)) Next sedqtr = se End Function  

أولا أخي أمير أنا لا أفضل و لا أحبذ البحث التلقائي عن قاعدة البيانات لأن هذا سوف يتطلب وقتا كبيرا و يجب تحديد اسم القاعدة التي يبحث عنها لذلك لاحظ معي:
1- يجب وضع كود في النموذج الرئيس ليتأكد من أن قاعدة البيانات موجودة أم لا.
     إذا كانت القاعدة موجودة يفتح البرنامج بشكل طبيعي
    و إذا كانت القاعدة غير موجودة يفتح نموذج الإتصال لتقوم أنت بتحديد مكان القاعدة و هكذا.
2- بالنسبة للتعامل مع الأكسس في الشبكات فهو بسيط جدا نفس الخطوات السابقة فقط تقوم بمشاركة مجلد القاعدة الموجود على جهاز السرفر و تستطيع الإتصال بها من أي جهاز آخر.

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

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

جرب الكود بهذا الشكل:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "zaher", CurrentProject.Path & "\xx.xls", True, "A7:K" DoCmd.SetWarnings False DoCmd.RunSQL "delete from zaher Where isnull([المجموع/ض]) and isnull([المجموع])" DoCmd.SetWarnings True  

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

تفضل
 
إضافة و حذف مرفقات.rar

السلام عليكم
آسف أخي ابو آمنة لأنني لم أدخل للمنتدى منذ يومين أو ثلاثة
نعم يمكن حل مشكلتك بالطريقة التي أشار إليها الأخ أبو عارف فهي تكفيك عناء الذهاب للوورد
لكني سوف أعطيك حلا بالطريقة التي تريدها أنت لتصبح لديك طريقتين و أنت إختار ما تشاء.
لقد قمت بالتعديل على الملف ليقوم بإخراج ملف pdf لكل شخص و برقمه الوظيفي و يضعها في مجلد واحد اسمه ملف الشهادات طبعا عن طريق المرور بالوورد و يكون شكل الشهادة هكذا:
 
export to word.rar

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

لاحظ الكود جيدا سوف تجد أنني عرفت متغيرا في أعلى صفحة الأكواد بهذا الشكل:
Dim n As Integer يجب عليك إضافته

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

السلام عليكم
أخي ابو زاهر استعمل هذا الكود:
On Error Resume Next Dim x As String x = Me.Rajmsanf.Text Me.Rajmsanf = UCase(x) Me.Rajmsanf.SelStart = Len(x) Me.Rajmsanf.SelLength = 0 و هذا المرفق بعد التعديل
 
حروف كبيره .rar

السلام عليكم
أضف هذا الكود في حدث بعد التحديث لمربع النص:
Dim x As Integer, x1 As Integer, x2 As Integer x = DateDiff("n", "7:30", Time()) x1 = Int(x / 60) x2 = (x - x1 * 60) Me.نص24 = x1 & IIf(x1 > 2, " ساعات و ", " ساعة و ") & x2 & IIf(x2 > 2 And x2 < 11, " دقائق", " دقيقة") و هذا المرفق بعد التعديل:
 
سجل 1.rar

السلام عليكم
هذه أحد الحلول حسب الطريقة التي تستعملها
ضع هذا الكود في حدث عند التحميل للنموذج
DoCmd.GoToRecord , , acNewRec  

السلام عليكم :
استعمل هذا الكود في حدث عند التحميل لنموذج لمنع التعديل على السجلات السابقة:
Me.AllowEdits = False و استعمل هذا الكود خلف زر أمر لسماح بالتعديل على سجلات النموذج:
Dim x As Integer x = InputBox("ادخل كلمة السر", "السماح بالتعديل") If x = 1988 Then Me.AllowEdits = True End If  

السلام عليكم
أكتب العبارة المطلوبة في خانة القيمة الإفتراضية بإحدى الطريقتين في الصور التالية:
1-

2-

تفضل هذا التعديل:
 
حساب الوقت.rar

السلام عليكم
نعم أخي كان هناك خطأ بسيط يمنع المرفق من العمل مع كل الملفات و لكنني أصلحته الآن تفضل:
Dim strTargetDB As String Dim tbl As TableDef Dim app As Access.Application strTargetDB = Me.txtPath1 Set app = CreateObject("Access.Application") app.OpenCurrentDatabase (Me.txtPath) app.Visible = False For Each tbl In app.CurrentDb.TableDefs If Left(tbl.Name, 4) <> "MSys" Then app.DoCmd.TransferDatabase acExport, "Microsoft Access", strTargetDB, acTable, tbl.Name, tbl.Name, False End If Next MsgBox "لقد تم تصدير جميع الجداول بنجاح" و هذا هو المرفق:
 
1‏‏kanory.rar