نجوم المشاركات

جرب هذا ..... Private Sub أمر12_Click() On Error GoTo err_أمر12_Click Dim stLinkCriteria As String stLinkCriteria = "[ID] =" & Me![ID] DoCmd.OpenReport "TG", acViewPreview, , stLinkCriteria exit_أمر12_Click: Exit Sub err_أمر12_Click: If Err.Number = 3075 Then MsgBox "ضع رسالتك هنا" Resume exit_أمر12_Click Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub

جرب اكتب قبل الكود on error resume next احتمال تختفي وما عاد تظهر

غير الكود الى On Error Resume Next Dim stLinkCriteria As String stLinkCriteria = "[ID] =" & Me![Id] DoCmd.OpenReport "TG", acViewPreview, , stLinkCriteria

السلام عليكم 🙂 اللغة العربية هي المطلوبة هنا 🙂 المرفق المضغوط فيه مجلد وبرنامج اكسس ، والبرنامج اللي يعمل لنا QR code الموجود على الرابط التالي: https://sourceforge.net/projects/zint/ ويتم حفظ الصورة هنا Data > QR_images وعلشان كل شيء يشتغل تمام ، رجاء لا تعمل تغيير في مكان الملفات ولا المجلدات ، ولا تغيير اسمائها (طبعا تقدر تعمل اللي تريد ، بس على اساسه يجب تغيير الكود كذلك) وهي النتيجة: وخلونا نشوف من يقدر يقرأ الصورة 🙂 ----------------------------------------------------------------------------- إضافة في يوم الثلاثاء 7 / 5 / 2019 : عملت مثال يعمل على 2003 🙂 ----------------------------------------------------------------------------- إضافة في يوم الجمعة 14 / 6 / 2019 : باركود بطاقة دخول الطائرة (Boarding card) وهي من نوع PDF417 اختار الحقول اللي تريدها تظهر في QR code بإختيار مربع صح/خطأ : . والنتيجة: . و باركود 128 (ويمكن عمل اي نوع من انواع الباركود) . والتقرير (وبعد اذن اخي محمد سلامه ، فقد استعملت الصورة التي استعملها في مثاله 🙂 ) . وبهذه الطريقة نرى اننا لا نحتاج ان نحفظ صورة لكل سجل (واذا اردنا ذلك ، فنعمل تعديل في الكود ليقوم بذلك). وهذا الكود مضافا اليه عمل الباركود العادي : Private Sub Make_QR_Barcode() ' 'https://sourceforge.net/projects/zint/ ' If Len(Me.str_Text & "") = 0 Then Exit Sub Dim App_Name As String Dim Output_File As String Dim Output_Text As String Dim Encoding As String Dim Command_Line As String App_Name = Chr(34) & Application.CurrentProject.Path & "\Data\zint.exe" & Chr(34) Output_Text = Chr(34) & Me.str_Text & Chr(34) 'QR code Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "QR_code.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --scale=2 -w 10 --height=100 --barcode=58 -d " & Output_Text 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide 'Barcode 128 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "Barcode.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 -d " & Me.ID 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide 'PDF 417 Output_File = Chr(34) & Application.CurrentProject.Path & "\Data\QR_images\" & "PDF_417.png" & Chr(34) Command_Line = App_Name & " -o " & Output_File & " --rotate=0 --eci=24 --binary --barcode=55 --mode=3 -d " & Output_Text 'Debug.Print Command_Line Shell_n_Wait Command_Line, vbHide End Sub ----------------------------------------------------------------------------- إضافة في يوم الجمعة 22 / 6 / 2019 : تم عمل VCard QR ليخزن معلومات الشخص مباشرة في الموبايل 🙂 . وبإستخدام برامج الموبايل والتي تقرأ QR Code ، يمكنك حفظ معلومات VCard QR مباشرة في عناوين الموبايل 🙂 البرنامج zint الموجود في المرفق ، فيه امكانية عمل عدة انواع من QR والباركودات ، ولكن كل نوع من هذه الانواع له صيغة خاصة في عمله ، فمثلا كود VCArd QR هو: Function Add_Items() Dim VCard_Text As String 'clear field VCard_Text = "" VCard_Text = "BEGIN:VCARD" & vbCrLf VCard_Text = VCard_Text & "VERSION:3.0" & vbCrLf VCard_Text = VCard_Text & "N:" & Me.[Family Name] & ";" & Me.[Given Name] & ";" & Me.[Additional Name] & ";" & Me.[Name Prefix] & ";" & vbCrLf VCard_Text = VCard_Text & "FN:" & Me![Name] & vbCrLf VCard_Text = VCard_Text & "ORG:" & Me.[Organization 1] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 1 - Type] & ",VOICE:" & Me.[Phone 1 - Value] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 2 - Type] & ",VOICE:" & Me.[Phone 2 - Value] & vbCrLf VCard_Text = VCard_Text & "TEL;TYPE=" & Me.[Phone 3 - Type] & ",VOICE:" & Me.[Phone 3 - Value] & vbCrLf VCard_Text = VCard_Text & "ADR;:" & ";;" & Me.[Address 1] & ";;;;" & vbCrLf VCard_Text = VCard_Text & "BDAY:" & Me.[Birthday] & vbCrLf VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 1 - Type] & ":" & Me.[E-mail 1 - Value] & vbCrLf VCard_Text = VCard_Text & "EMAIL;TYPE=" & Me.[E-mail 2 - Type] & ":" & Me.[E-mail 2 - Value] & vbCrLf VCard_Text = VCard_Text & "NOTE:" & Me.Notes & vbCrLf VCard_Text = VCard_Text & "URL:" & Me.[Website 1] & vbCrLf VCard_Text = VCard_Text & "END:VCARD" Add_Items = VCard_Text End Function والذي يختلف عن PDF417 والذي يختلف عن غيره. المرفق في ملفين بصيغة txt والذي فيهما جميع الاوامر التي يمكن استعمالها لعمل مختلف انواع الباركود 🙂 ----------------------------------------------------------------------------- إضافة في يوم السبت 2 / 11 / 2019 : هنا مثال لعمل بطاقة عمل ID.zip ، بأصغر حجم QR code (رجاء ابقاء حجمه ، فقد توصلت الى هذا الحجم والكود بعد محاولات ساعات طويلة) : . وهذا هو QR code . اما تفاصيل عمل البطاقات ، فهذا الرابط فيه تفاصيل كاملة: . جعفر ملاحظة: 1. المرفق في هذه المشاركة هو البرنامج الاخير ، وفيه جميع التعديلات التي في بقية المشاركات. 2. الـ api التي تنتظر إنتهاء الامر ، ثم تنتقل للسطر التالي في الكود اسمها ShellWait ، هذه لا تتعامل مع Unicode / utf-8 / ومنها الحروف العربية بطريقة صحيحة : http://access.mvps.org/access/api/api0004.htm بينما هذه تمام : https://github.com/xxdoc/vb6-Shell-Wait/blob/master/Shell %26 Wait v2/modShellWait.bas zint QR 3.zip ID.zip Shell_n_Wait_2021-12-13.txt.zip

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

تفضل لك ما طلبت متابعة دوام.xlsx

السلام عليكم ورحمة الله تعالى وبركاته اتمنى ان تكونو جمبعا بخير حال الموضوع اليوم قد وضحه العنوان كنت قد وعدت الاخوة فى هذا الموضوع ببعض التحديثات فوجدت ان كل هذه التحديثات يقدمها تطبيق واتساب اتجهت بفضل الله وكرمه الى محاكات نظام واتساب بالاكسس هذا الموضوع هدية لككم واتمنى ذكر الحقوق ان امكن ذلك والان مع الشرح اعتذر لرفعه على موقع خارجى لانتهاء المساحه هنا حجمة 2 ميجا فقط https://www.mediafire.com/file/ir1l91d6g18d8iy/AccessWatsapp.rar/file اتمنى التجربة واعلامى بالنتائج شكرا لكم

انا في البدايه بحب اشكر الساده مسئولي موقع اوفيسنا علي قبولي كعضو و احب اشارك بالبرنامج ده من تصميمي يارب يعجبكم و احب اسمع اي تعليق عليه لو فيه فرصه للتحسين البرنامج عليه بيانات للتجربه المستخدم : User 1 كلمه السر : 1234 مسار الملف https://www.4shared.com/rar/qjf1M8dzgm/SSP_2019_-_V_4_Demo.html

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

بالعكس اخي الكريم @essam rabea تعدد الاجابات مطلب لكي نستفيد ايضا ..... لأن الموقع تعليمي في اساسه

هناك حل أن تجعل كود الصنف نص وليس رقم وإن كان لابد ان يكون حقل كود الصنف رقم فإجعل خاصية Formate لهذا الحق (00000000) بحسب كم رقما تريد لهذا الكود كحد أقصى. أرجو أن أكون أوضحت الفكرة أخى Barna إقبل إعتذارى فلم أنتبه أنك شاركت

جزاك الله خيرا وفتح عليك من علمه

وعليكم السلام بارك الله فيك استاذنا الكريم وزادك الله من فضله

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

ممكن تنظر الى هذا الرابط https://www.officena.net/ib/topic/90710-ارتباط-تشعبي-لأسماء-ملفات-مجاورة/?tab=comments#comment-569736

وعليك السلام ورحمة الله وبركاته وبعودة الأيام ممكن إخفاء CommandButton قبل الطباعة ثم رجوعه بعد الطباعة فيمكنك طباعة الفورم بدون الأزار كمثال لو لديك زر أمر 1 يكون هكذا ويمكنك تكملة باقي الأزار بنفس الفكرة CommandButton1.Visible = False UserForm2.PrintForm CommandButton1.Visible = True

تسلم الأنامل أستاذ وجيه ولكن بعد إذن حضرتك لاحظت أن رقم 2 قام بالدخول ولم يقم بالخروج لذلك رأيت أنه من الأفضل عمل بعض التعديلات حتى تأتي بالنتيجة المرجوة بإضافة عمود مساعد ممكن تجربه هذا أستاذ سليم الاخرس رمضان كريم وكل عام أنتم بخير بصامة.xlsx

بارك الله فيكم استاذنا الفاضل وجعله الله فى ميزان حسناتك

مشكور جدا أستاذي الكريم ان شاء الله في ميزان حسناتك

كل المحبة والاحترام

لا اعلم وان وجدت شيئا زودتك به .

جزاك الله كل خير وبارك الله لك

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

أخي @حلبي اخيرا وجدت الملف .. الملف من تطوير أعتقد أخونا الغالي @محمد سلامة أسائل الله أن يجزيه عنا وعن المسلمين خيراً طبعاً الملف الذي أضاف الأستعادة تطوير أحد أخوة من زملائنا بالمنتدى الغالي أوفيسنا .. لا أتذكر من الأخ.... الذي أخذت منه الملف .. أو أنه يطلع أخونا @مسفر وأنا لا أدري وياريت أعرف أسمه أضعة بجانب الملف حتى أتذكره وأدعو له المهم ... هو كذلك أسائل الله أن يجزيه عنا وعن المسلمين خيراً .. مرفق الملف Backup.rar

بتاسف ليك استاذ سليم فقد حملت لك المشاركة السابقة واليك الملف من جديد بصامة.xlsx

عليكم السلام هذه وحدة نمطية عامة تتحكم في اظهار واخفاء جميع الكائنات .. وتستطيع تعطيل اي كائن او تركه يعمل Public Function HideAndShowAll(vbln As Boolean) Dim obj As AccessObject Dim dbs As Object Dim db As Database Dim T As TableDef Dim TName As String Dim I As Integer Dim vCnt As Integer Set db = CurrentDb() Set dbs = Application.CurrentProject On Error Resume Next For Each obj In dbs.AllForms Application.SetHiddenAttribute acForm, obj.Name, vbln Next obj For Each obj In dbs.AllReports Application.SetHiddenAttribute acReport, obj.Name, vbln Next obj For Each obj In dbs.AllModules Application.SetHiddenAttribute acModule, obj.Name, vbln Next obj For Each obj In dbs.AllMacros Application.SetHiddenAttribute acMacro, obj.Name, vbln Next obj Set dbs = Application.CurrentData For Each obj In dbs.AllQueries Application.SetHiddenAttribute acQuery, obj.Name, vbln Next obj For I = 0 To db.TableDefs.Count - 1 Set T = db.TableDefs(I) TName = T.Name If Not TName Like "msys*" Then Application.SetHiddenAttribute acTable, TName, vbln vCnt = vCnt + 1 End If Next I End Function ونستدعيها من اي حدث هكذا : للإخفاء : HideAndShowAll(true) وللإظهار : HideAndShowAll(false) لاحظ انك لو استدعيت الكود في زر داخل نموذج فلن يتفاعل النموذج والسبب انه مفتوح ، ولكن من الماكرو مثلا يتم التطبيق على الكل hidAshow.mdb

كما تفضل أخى عبد اللطيف سلوم وطالب بمثال للتطبيق عليه .. أضم صوتى لصوته كى تحصل على أعلى فائدة .. ولكن جرب أن تجعل خاصية التنسيق لـ ( إجمالى المبلغ ) ثابت و المنازل العشرية له 2

ا / وجيه ... رمضان مبارك . اتابع ابدعاتك المتميزة .. لي سؤال لحضرتك هل يمكن عمل معادلة للملف السابق << بدون .. معادلة صفيف <<

اهلاً معلمي الغالي, تلبية لطلبك الكريم قمت بجمع الطريقتين بملف واحد اذا وضعت مسار ملف صوت MP3 او WAV فهو سيقوم بفلترة المدخلات وتشغيلها حسب صيغتها. Option Compare Database Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias _ "mciSendStringA" (ByVal lpstrCommand As String, ByVal _ lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _ hwndCallback As Long) As Long Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _ (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long Private Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long Const SND_ALIAS_SYSTEMASTERISK As String = "SystemAsterisk" Const SND_ALIAS_SYSTEMDEFAULT As String = "SystemDefault" Const SND_ALIAS_SYSTEMEXCLAMATION As String = "SystemExclamation" Const SND_ALIAS_SYSTEMEXIT As String = "SystemExit" Const SND_ALIAS_SYSTEMHAND As String = "SystemHand" Const SND_ALIAS_SYSTEMQUESTION As String = "SystemQuestion" Const SND_ALIAS_SYSTEMSTART As String = "SystemStart" Const SND_ALIAS_SYSTEMWELCOME As String = "SystemWelcome" Const SND_ALIAS_YouGotMail As String = "MailBeep" ' playsound Params Const SND_LOOP = &H8 Const SND_ALIAS = &H10000 Const SND_NODEFAULT = &H2 ' silence if no sound associated with event Const SND_ASYNC = &H1 ' play async (don't freeze program while sound is playing) Private sMusicFile As String Dim Play, a Public Sub Sound_MP3(ByVal File$) sMusicFile = GetShortPath(File) Play = mciSendString("play " & sMusicFile, 0&, 0, 0) If Play <> 0 Then End If End Sub Public Sub Stop_MP3(Optional ByVal FullFile$) Play = mciSendString("close " & sMusicFile, 0&, 0, 0) End Sub Public Function GetShortPath(ByVal strFileName As String) As String Dim lngRes As Long, strPath As String strPath = String$(165, 0) lngRes = GetShortPathName(strFileName, strPath, 164) GetShortPath = Left$(strPath, lngRes) End Function Private Sub DoStartSound_Click() If IsNull(SoundPath) Then MsgBox "! áã ÊÞã ÈæÖÚ ãÓÇÑ ãáÝ ÇáÕæÊ", vbCritical, "ÚãáíÉ ÎÇØÆÉ" Exit Sub End If Dim Fix_Path As String Fix_Path = Mid(SoundPath, 2) Dim Rev_Extension As String Rev_Extension = FExtOnly(Fix_Path) If IsFile(Fix_Path) = False Then MsgBox "! áã íÊã ÇáÚËæÑ Úáì ÇáãáÝ", vbCritical, "ÚãáíÉ ÎÇØÆÉ" Exit Sub End If Select Case Rev_Extension Case "mp3" Sound_MP3 (Fix_Path) Case "wav" PlaySound Fix_Path, vbNull, SND_ALIAS Or SND_NODEFAULT Or SND_ASYNC Or SND_LOOP End Select Debug.Print Fix_Path End Sub Function IsFile(ByVal fName As String) As Boolean On Error Resume Next IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory) End Function Function FExtOnly( _ ByVal filename As String) _ As String Dim nopath As String Dim dpos As Long Dim spos As Long spos = InStrRev(filename, "\") If spos > 0 Then nopath = Mid(filename, spos + 1) Else nopath = filename End If dpos = InStrRev(nopath, ".") If dpos > 0 Then FExtOnly = Mid(nopath, dpos + 1) Else FExtOnly = "" End If End Function Private Sub DoStopSound_Click() Dim Fix_Path As String Fix_Path = Mid(SoundPath, 2) Dim Rev_Extension As String Rev_Extension = FExtOnly(Fix_Path) Select Case Rev_Extension Case "mp3" Stop_MP3 (Fix_Path) Case "wav" PlaySound vbNullString, ByVal 0&, SND_NODEFAULT End Select End Sub حسنين MP3_WAV_Player_SEMO_Pa3x.accdb

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

بارك الله فيك استاذ جعفر .. ماقصرت .. تحياتي

السلام عليكم اسمحوا لي ان اوضح بعض المعلومات صيغة accdb بدأت بالاكسس 2007 ، ولكن ليس جميع خواص accdb متوافقة بين الاصدارات 2007-2016 !! وهناك الكثير من الميزات الموجودة في 2010 ، ليست موجودة في النسخة الاولى من اصدار 2007 ، وانما هي موجودة عند تحديث 2007 بحزم التحديث Service pack ، ولكن ، الميزات الاخرى والموجودة في 2010 او 2013 او 2016 مثل: حدث الجداول ، برامج الويب ، تكبير الصفحات (zoom) ، و .... ، فإنها اصلا غير موجودة لإصدارات الاكسس الاقدم. جعفر

خطر فى بالى شئ لاضفاء مرونة فى الية التعامل ومغالجة البيانات قمت بانشاء جدول باسم tbl_chosen_date_Age_Calcفى هذه الجدول نكتب التاريخ المراد احتساب العمر عنده اى 1/10/2018 لان المرفق السابق انا كتبت كودلاحتساب العمر حتى 1/10 ثم العام التالى اى انه لو قمنا بتشغيل المرفق السابق فى اول عام 2018 يتم احتساب العمر فى 1/10/2019 ولذلك فكرت فى التعديل الاتى وتم تدارك تلك المشكله بهذه الفكرة استخراج السن فى اول اكتوبر عن طريق دالة فى الاستعلام_ update.rar

بارك فيكم اخواني جميعاً و بعد اذنكم اساهم معكم في الحل تم تغيير اسم الجدول و الحقول الى الانجليزية ليسهل التعامل معها ... و تم حذف حقلي تاريخ الميلاد و النوع من الجدول و عمل استعلام يظهرهما بحقول محسوبة تاريخ الميلاد : BirthDate النوع : Gender بالتوفيق للجميع قاعدة البيانات2.rar

السلام عليكم لأخذ كود المحافظة من الرقم القومى نستخدم هذا التعبير Moh1: (Mid([الرقم القومى];8;2)) أى نأخذ رقمين بدءا من الرقم الثامن من اليسار و بطول رقمين ثم نبحث داخل جدول أكواد المحافظات عن هذين الرقمين باستخدام dlookup MyMoh: DLookUp("[MohaName]";"tblmohafzat";"[Mohid]=" & [moh1]) أرجو إكمال جدول المحافظات saeyd5.rar