Shivan Rekany

تم تعديل New folder1.rar

اتفضل New folder1.rar

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

اتفضل New folder1.rar

اتفضل اليك هذا السطر بدل من القبل Private Sub Form_Current() On Error Resume Next If Len(Me.year1 & "") < 1 And Len([Forms]![main]![Glose] & "") <> 0 Then Me.year1 = Nz(DMax("[year1]", "id", "[Glose]=" & [Forms]![main]![Glose]), " ") + 1 Else Exit Sub If Len(Me.id & "") = 0 Then Me.id = Nz(DMax("[id]", "id", "[Glose]=" & [Forms]![main]![Glose]), 0) + 1 Else Exit Sub End Sub وهذا تعديل على الملف dgree (1).rar

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

لا اعلم هل قصدك بهذا ام شيء اخر PICTURE.rar

اتفضل اخي انا استخدمت هذه الاكواد للنموذج Option Compare Database Dim Sec As Integer Public Function PicName(FullPic_Name As String) Dim Pic_ExtensionPosition As Integer Pic_ExtensionPosition = InStr(1, FullPic_Name, ".") + 3 PicName = Mid(FullPic_Name, 1, Pic_ExtensionPosition) End Function Private Sub AddPictures_Click() On Error Resume Next Dim x As FileDialog Dim mynam As String Dim Mesar As String Set x = Application.FileDialog(msoFileDialogFilePicker) x.AllowMultiSelect = True If x.Show = -1 Then For i = 1 To x.SelectedItems.Count mynam = Mid$(Trim(x.SelectedItems(i)), InStrRev(Trim(x.SelectedItems(i)), "\") + 1) Dim newa As String newa = Mid$(Trim(x.SelectedItems(i)), InStrRev(Trim(x.SelectedItems(i)), ".") + 1) If newa = "jpg" Or newa = "png" Or newa = "ico" Or newa = "bmp" Or newa = "gif" Or newa = "tif" Or newa = "tga" Then FileCopy Trim(x.SelectedItems(i)), CurrentProject.Path + "\fileStores\" & ("" & mynam & "") Me.PicFile = "\fileStores\" & ("" & mynam & "") Me.imgPicture.Picture = CurrentProject.Path + "\fileStores\" & ("" & mynam & "") ElseIf newa = "mp3" Or newa = "wma" Or newa = "ape" Or newa = "amr" Or newa = "wav" Or newa = "mp4" Or newa = "avi" Then FileCopy Trim(x.SelectedItems(1)), CurrentProject.Path + "\fileStores\watch\" & PicName("" & mynam & "") Me.PicFile = "\fileStores\watch\" & ("" & mynam & "") Me.imgPicture.Picture = CurrentProject.Path + "\fileStores\watch\" & ("" & mynam & "") ElseIf newa = "txt" Or newa = "docx" Or newa = "doc" Or newa = "exlx" Then FileCopy Trim(x.SelectedItems(1)), CurrentProject.Path + "\fileStores\doc\" & ("" & mynam & "") Me.PicFile = "\fileStores\doc\" & ("" & mynam & "") Me.imgPicture.Picture = CurrentProject.Path + "\fileStores\doc\" & ("" & mynam & "") End If DoCmd.GoToRecord , , acNext Next i Me.imgPicture.Requery End If Set x = Nothing End Sub Private Sub AutoChange_Click() Me.StopAndResume.Visible = True Me.StopAndResume.Caption = "Stop" Me.TimerInterval = 1000 DoCmd.GoToRecord , , acFirst End Sub Private Sub Command21_Click() On Error Resume Next Dim MyPict As String DoCmd.SetWarnings False MyPict = CurrentProject.Path & Me.PicFile Kill (MyPict) DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord Me.Requery DoCmd.SetWarnings True MsgBox "تم الحذف" End Sub Private Sub Command22_Click() On Error Resume Next Dim MyPict As String DoCmd.SetWarnings False MyPict = (CurrentProject.Path & "\" & "fileStores\*.*") Kill (MyPict) DoCmd.RunCommand acCmdSelectAllRecords DoCmd.RunCommand acCmdDeleteRecord Me.Requery DoCmd.SetWarnings True MsgBox "تم الحذف" End Sub Private Sub Form_Current() On Error Resume Next Dim newa As String newa = Mid$(Trim(Me.PicFile), InStrRev(Trim(Me.PicFile), ".") + 1) If newa = "jpg" Or newa = "png" Or newa = "ico" Or newa = "bmp" Or newa = "gif" Or newa = "tif" Or newa = "tga" Then If Len(Me.PicFile & "") <> 0 Then Me.imgPicture.Picture = CurrentProject.Path + Me.PicFile Else Me.imgPicture.Picture = "" Else Me.imgPicture.Picture = "" End If End Sub Private Sub Form_Timer() Sec = Sec + 1 If Sec >= 3 And Me.CurrentRecord <> Me.RecordsetClone.RecordCount Then DoCmd.GoToRecord , , acNext Sec = 0 ElseIf Sec >= 3 And Me.CurrentRecord = Me.RecordsetClone.RecordCount Then MsgBox "وصلنا الى اخر صورة .. سيتم اغلاق النموذج" DoCmd.Close acForm, Me.Name End If End Sub Private Sub StopAndResume_Click() If Me.StopAndResume.Caption = "Stop" Then Me.TimerInterval = 0 Me.StopAndResume.Caption = "Resume" Exit Sub ElseIf Me.StopAndResume.Caption = "Resume" Then Me.TimerInterval = 1000 Me.StopAndResume.Caption = "Stop" Exit Sub End If End Sub واليك القاعدة بعد تعديل واسف على التأخير pic.rar

الترقیم هو من نوع نمبر اذا تريد ان يكتب الترقيم تلقائي غير نوع الحقل من نمبر الى ترقيم تلقائي

اتفضل اليك هذا الكود Private Sub Form_Current() On Error Resume Next If Len(Me.year1 & "") < 1 And Len([Forms]![main]![Glose] & "") <> 0 Then Me.year1 = Nz(DMax("[year1]", "id", "[Glose]=" & [Forms]![main]![Glose]), " ") + 1 Else Exit Sub End Sub للعلم انا غيرت اسم الحقل للسنة من year الى year1 لانھ ھو اسم محجوز وانا غیرت نوعیتھ من تیکست الێ نمبر و انا ح«فت مفتاح اساسی لحقل ای دی لجدول ای دی ... لان في هذه الحالية لا يمكنك ان تكتب رقم مرتين اليك قاعدة بعد تعديل واسف على التاخير dgree.rar

للحذف الملف استخدم امر kill ولكي تمسح السجل مع الملف اليك هذا الرابط من قبل انا عملت لك ولفتح الملف من قبل انا عطيتك رأيي ان تفتح كل نوع من الملفت بواسطة برامجه مثلا ملف وورد بواسطة برامج وورد والخ اذا تريد هذا انتظرني

عندنا تازية اي مات احد من اقرباءنا لذلك ليس لدي وقت لكي افتح لابتوبي حتى يوم السبت الان انا عم استخدم موبايل اعتذر منك ... انتظرني حتى يوم السبت او حتى اجد وقت كافي للتعديل تقبل تحياتي

لا یجب ان یکون من نوع رقم

هناك نفس السؤال سئل سلمان الشهراني اتفضل قبل قليل انا رديت عليه

نعم هناك طريقة مثلا نريد ان يبدأ من رقم 100 سنستخدم هذا الكود =NZ(Dmax("[ID]","Tbl1"),99)+1 هذا الكود سيعطيك اكبر رقم من حقل اي دي في جدول تبل 1 واذا ما وجد اي رقم اي اذا ليس يكون هناك رقم في ذلك الحقل سيعطيك رقم 99 + 1 واذا كان هناك اكبر رقم في ذلك الحقل سيعطيك ذلك الرقم و يزيد عنه رقم واحد

شكرا استاذ جعفر اتفضلي كما قال استاذنا جعفر تقدر تستخدمي هذا الكود في حدث بعد تحديث لكومبوبوكس Private Sub Names1_AfterUpdate() Me.Job1 = DLookup("[Job]", "Employes", "[EmpNum]='" & Me.Names1 & "'") End Sub او تقدر تستخد هذا كمصدر مربع نصي ل جوب1 =DLookUp("[Job]";"Employes";"[EmpNum]='" & [Names1] & "'") واليك قاعدة بياناتك بعد استخدام الطريقة الثانية Rewards.rar

امسح اكواد النموذج والصق هذا Option Compare Database Dim resalh As Integer Private Sub Form_Open(Cancel As Integer) MessageBoxH Me.hwnd YES = "استراحة" NO = "مواصلة" End Sub Private Sub Form_Timer() a = MsgBox("أتريد استراحة لتجدد نشاطك أم لديك الرغبة للمواصلة؟", vbMsgBoxRight + vbYesNo, "مرت 30 دقيقة وربما تحتاج لاستراحة قصيرة") If a = vbYes Then DoCmd.Close DoCmd.OpenForm "Rest" End If End Sub او قم بالتعديل و اضافة كود في حدث عند فتح New Microsoft Access Database (1) (1).rar

تريد نغيير اي كود الى اي من صورة اعلى الى اسفل او تغيير الكود صورة اسفل مثل للاعلى

حسب علمي فقط اكتب هذا الامر في اخر الكود بعد تحديث لحقل الباركود DoCmd.GoToRecord , , acNewRec وبهذا وبعد قراءة الباركود سيروح مؤشر الماوس الى سجل جديد وفي نفس الحقل الباركود لكن تأكد منه في حدث بعد تحديث للحقل الباركود من اسم اي حقل مع هذه الكلمة SetFocus احذفه او قبل سطر الاعلاه للسجل جديد اكتب ME.اکتب_اسم_حقل_البارکود.SetFocus والا ارفق نسخە مصغرە من قاعدە بیانات لکی نعمل علیە

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

اتفضل اخي في محرر الاكواد وبعد تحديث حقل التوجيه الصق هذا الكود Me.رقم_الفاتوره = Nz(DMax("[رقم الفاتوره]", "مجمع الفواتير اجمالى", "[التوجيه]='" & [التوجيه] & "'"), 0) + 1

اتفضل اليك ما طلبت لكن ارجوا ان لا نتعدى قوانين المنتدى .. لكل موضوع سؤال جديد بعد البحث عن ما يريد هذا هو الكود لحذف الصور مع السجل Private Sub Command21_Click() On Error Resume Next Dim MyPict As String DoCmd.SetWarnings False MyPict = CurrentProject.Path & Me.PicFile Kill (MyPict) DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord Me.Requery DoCmd.SetWarnings True MsgBox "تم الحذف" End Sub وهذه لحذف جميع الملفات من فولدر و حذف جميع السجلات Private Sub Command22_Click() On Error Resume Next Dim MyPict As String DoCmd.SetWarnings False MyPict = (CurrentProject.Path & "\" & "fileStores\*.*") Kill (MyPict) DoCmd.RunCommand acCmdSelectAllRecords DoCmd.RunCommand acCmdDeleteRecord Me.Requery DoCmd.SetWarnings True MsgBox "تم الحذف" End Sub ولطلبك هذا فقط تم حذف هذا CurrentProject.Path + من هذا Me.PicFile = CurrentProject.Path + "\fileStores\" & ("" & mynam & "") اي يبقى هذا Me.PicFile = "\fileStores\" & ("" & mynam & "") واليك الملف بعد تعديل والاضافة ولا تنسى اختار افضل جواب لكي من يفتح هذا الموضوع يعرف ويستفيد اكثر تقبل تحياتي pic.rar

اولا يجب ان يكون مصدر الكومبوبوكس بيكون ليست بوكس ثانيا يجب ان يكون خصائصه هكذا

فی الحقیقة انا فتحت هذا الموضوع من قبل لكن انا ما فهمت اي شيء .. لذلك تركت هذا الموضوع بدون تعليق اتمنى ان اشوف وجهك الطيب ولو لبعض دقائق و نشرب كاسة من القهوة بسوى