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

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

بضحك لأنى كنت ناوى أقول جرب الكود هذا وكنت متردد Dim fso As New FileSystemObject Dim strDesktopPath As String: strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") If fso.FolderExists(strDesktopPath & "\Folder2") Then: Else: fso.CreateFolder (strDesktopPath & "\Folder2") DoCmd.RunSavedImportExport "export" Dim ExceToLocC As String: ExceToLocC = "C:\Table1.xlsx" Dim ExcelCopy As String: ExcelCopy = strDesktopPath & "\Folder2\Table1.xlsx" FileCopy ExceToLocC, ExcelCopy: Kill ("C:\Table1.xlsx")

طيب شوف التحايل هذا ....... Dim fso As New FileSystemObject Dim LExcelOriginal As String Dim LExcelCopyOf As String Dim msgstyle If fso.FolderExists(Environ("USERPROFILE") & "\Desktop\" & "\Folder2") Then Else fso.CreateFolder (Environ("USERPROFILE") & "\Desktop\" & "\Folder2") End If DoCmd.RunSavedImportExport "export" LExcelOriginal = "D:\Table1.xlsx" LExcelCopyOf = Environ("USERPROFILE") & "\Desktop\" & "Folder2" & "\" & "Table1.xlsx" FileCopy LExcelOriginal, LExcelCopyOf Kill ("D:\Table1.xlsx") MsgBox Space(20) & "تمت العملية بنجاح.." & Space(20), msgstyle, "للمعلومية" ملفك بد التعديل .... Create Folder2 (1).accdb

وعليكم السلام ورحمة الله وبركاته تفضل اخى الكريم ليجلب لك مسار سطح المكتب Dim strPath As String strPath = Environ("USERPROFILE") & "\Desktop\"

تفضل هذا التعديل تم عمل بعض التعديلات حيث ان تم انشاء جدول للطلبات و جدول للموظفين و يتم جمع جميع طلبات الموظف داخل الارشيف في حدث الحالي A- DATA.accdb

تفضل التعديل Msaneed List.zip

وعليكم السلام ورحمة الله وبركاته اخى الكريم تفضل هذا الملف طلبك ان شاء الله hide specific sheets.xlsm

ما هو سبب ارتجاف واهتزاز عناصر التحكم في النموذج عند تحريك الماوس في النموذج لبعض قواعد البيانات وخاصة عند استخدام سمات او اسطح الويندوز XP ؟ قد يكون الحل يدويا على مستوى حقل او حقلين لايوجد به مشكلة ولكن هل من المعقول نقوم بحل هذه المشكلة يدويا لعدد 30 او اربعين مربع نص او عنصر تحكم على النموذج اذن يكون الحل برمجيا . اولا لنعرف السبب . ان الارتجاف او الاهتزاز هو ناتج عن فقد اقتران مربع التسمية بمربع النص التابع له لهذا يحدث ما يسمى بالـ Flicker with tab controls وتحدث هذه المشكلة عند حذف مربع التسمية الاصلي لمربع النص واستبداله بآخر غير مقترن او وضع زخرفات زائدة لمربع التسمية . ولحل هذه المشكلة لديك عدة خيارات : 1. اما ان تجعل سمات الويندوز على وضع كلاسيكي وهذا حل غير عملي لانه سيستخدم هذه القاعدة غيرك لديهم سمات ويندوز XP نشطه . 2.. في حالة فقدان اقتران مربع التسمية بمربع النص الخاص به تظهر في الركن العلوي الايمن علامة مثلث اخضر وعليه تنبيه لو قمت بتقريب الماوس الى هذا المثلث والضغط بالماوس الايمن عليه ستظهر لك قائمة منبثقة ( النموذج في حالة وضع التصميم ) ومن ضمن خياراتها اقتران مربع التسمية بمربع النص التاابع له وستحل المشكلة يدوبا . 3. والحل الاخير هو برمجيا لهذا نتبع هذه الطريقة : 1. قم بإنشاء وحدة نمطية جديده . 2. قم بنسخ هذا الكود للوحدة النمطية ومن ثم قم بحفظها . Function ConvertLabelOnTabPage(strFormName As String, _ Optional bSaveAndClose As Boolean, Optional bHidden As Boolean) 'الغرض : تغيير التسميات الغير مرتبطة بمربعات النص في النموذج 'لاصلاح مشكلة الاهتزاز في سمات الويندوز اكس بي Dim frm As Form Dim ctl As Control Dim strName As String Dim strCaption As String Dim bytBackStyle As Byte Dim bChanged As Boolean Const strcQuote = """" 'افتح النموذج في وضع التصميم DoCmd.OpenForm strFormName, acDesign, _ windowmode:=IIf(bHidden, acHidden, acWindowNormal) Set frm = Forms(strFormName) 'البحث عن مربعات التسميات العائدة لمربعات النص 'Find the labels whose parent is a tab page. For Each ctl In frm.Controls If ctl.ControlType = acLabel Then If ParentIsTabPage(ctl) Then bChanged = True strName = ctl.Name 'اسم مربع النص الذي فقد التسمية strCaption = ctl.Caption 'تسمية مربع النص bytBackStyle = ctl.BackStyle 'برنامج الاكسيس لا يمكنه عمل هذا Debug.Print strFormName & "." & strName 'Convert it to a text box. ctl.ControlType = acTextBox 'Set the text box properties. With frm.Controls(strName) 'اسماء مربعات النص لغير محدد .ControlSource = "=" & strcQuote & _ Replace(strCaption, strcQuote, strcQuote & strcQuote) & strcQuote .Enabled = False .Locked = True .BackStyle = bytBackStyle End With End If End If Next Set ctl = Nothing Set frm = Nothing If Not bChanged Then DoCmd.Close acForm, strFormName, acSaveNo ElseIf bSaveAndClose Then DoCmd.Close acForm, strFormName, acSaveYes End If End Function Private Function ParentIsTabPage(ctl As Control) As Boolean On Error Resume Next ParentIsTabPage = (ctl.Parent.ControlType = acPage) End Function Function FixAllForms() 'الغرض : تشغيل تحويل مربعات التسميات جميعها في قاعدة البيانات 'تحذير : قم بحفظ قاعدة البيانات قبل عمل هذا الاجراء Dim accobj As AccessObject For Each accobj In CurrentProject.AllForms Call ConvertLabelOnTabPage(accobj.Name, True, True) Next End Function 3. لاجراء اختبار وانت داخل الوحدة النمطية من نافذة Immediate التي تستطيع الوصول لها بضغط المفاتيح Ctrl+G من لوحة المفاتيح وكنابة هذا الامر ? ConvertLabelOnTabPage("MyForm") MyForm اسم النموذج الخاص بك ثم اضغط Enter 4. ستظهر لك في النافذة السفلية جميع مربعات التسميات التي تم تحويلها وارتباطها بمربعات النص . 5. لاصلاح جميع مربعات التسميات في جميع النماذج في قاعدة البيانات استخدم هذا الامر بدلا عن السابق ? FixAllForms() ملاحظة : يجب اخذ نسخة احتياطية لقاعدة بياناتك قبل هذه العملية 6. لاصلاح مجموعة الخيار option groups لمربعات النص استبدل هذا الكود في دالة () ParentIsTabPage Private Function ParentIsTabPage(ctl As Control) As Boolean On Error Resume Next ParentIsTabPage = ((ctl.Parent.ControlType = acPage) Or _ (ctl.Parent.ControlType = acOptionGroup)) End Function

حلو التفكير بره الصندوق الفكرة ممتازة بس سبب ترددى فى وضع الكود لو الاكسس عللق كما يحدث احيانا ولم يتم مسح ملف الاكسل وكنت لسه بافكر وادورها براسى وحضرتك ما شاء الله وضعت الحل

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

استاذي الكبير @ابو جودي شكرا كثيرا لك بارك الله فيك ويحفظك من كل مكروه

ضع اخر كود زر الحذف Me.Requery

انت مش مشكلتك فى مسار سطح المكتب انت مشكلتك فى طريقة التصدير الغريبة بتاعتك وده مش تصدير دا امر نسخ وبصراحة انا مش فاهمه شغال ازاى ومن فين ضبط كودك او ابحث Dim fso As New FileSystemObject Dim strDesktopPath As String: strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") If fso.FolderExists(strDesktopPath & "\Folder2") Then Else fso.CreateFolder (strDesktopPath & "\Folder2") End If DoCmd.RunSavedImportExport "export" Dim strExportPath As String: strExportPath = strDesktopPath & "\Folder2\Table1.xlsx" fso.CopyFile strExportPath, True

اتفضل هذا السطر به حل مشكلتك Dim strDesktopPath As String: strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") حيث انه تم اسناد مسار سطح المكتب الى المتغير strDesktopPath يمكنك استدعاء المسار من خلال المتغير strDesktopPath انشئ زر امر وضع الكود الاتى يظهر لك مسار المجلد الخاص بسطح المكتب Dim strDesktopPath As String: strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") MsgBox (strDesktopPath) بعذ ذلك ما يأتى من كود يخصك انت

اتفضل جرب Create Folde.accdb

اخي العزيز @abouelhassan كود الاخ @king5starلا يعمل والحقل فارغ ..الافضل ان تضع رسالة تنبيه اذا كان حقل التاريخ فارغا حتى لايعطي رسالة خطا تحياتي

أخي @abouelhassan كود الأستاذ كنج 5 ستار يشترط كتابة ( التاريخ من ) لكي يعمل ..

شكرا بارك الله فيك اخي

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

You can't use formulas to move rows or delete rows and the code is very simple and it is basic

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Private Sub أمر146_Click() DoCmd.SetWarnings False DoCmd.RunSQL "DELETE table1.*, table1.علامة FROM table1 WHERE (((table1.علامة)=True));" DoCmd.SetWarnings True End Sub Private Sub تدقيق144_Click() DoCmd.SetWarnings False If Me.تدقيق144 = True Then DoCmd.RunSQL "UPDATE table1 SET table1.علامة = True;" ElseIf Me.تدقيق144 = False Then DoCmd.RunSQL "UPDATE table1 SET table1.علامة = False;" End If Me.Requery DoCmd.SetWarnings True End Sub حذف سجلات حسب تحديدها.rar تحياتي

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

المرفق الجديد -------------------- تم اضافة عدة استعلامات لعمل نموذج مستمر لعرض الصور على هيئة كتالوج النموذج الخاص بعرض الصور اسمه frmImages رجاء اضف اكثر من 10 صورة وافتح نموذج frmImages وهذه النتيجة من تجربتى Photo Catalog v3.1.mdb

شكراً أستاذى د.كاف يار هذا هو المطلوب

بعد اذن استاذي الكريم ابراهيم اذا كان القسط غير المسدد دائماً واحد فقط ضع هذه المعادلة IF(COUNTIF(H14:H35;"غير مسدد")=1;SUMIFS(F14:F35;H14:H35;"مسدد جزئي")+2000;SUMIFS(F14:F35;H14:H35;"مسدد جزئي"))

يبدوا اني لم افهم مطلوبك في مشاركتك الأولى جيدا شكرا د.كاف يار

تفضل هذا لتعديل Msaneed List.zip

كيف يعقل هذا ؟ 😱 الماكرو قمت بتشغيله وقام بالاخفاء وعند نقر على يمين ورقة البحث لايمكنك النقر على كلمة اظهار قمت بتخميل الملف مرة اخرى ويعمل معي تمام . قم بتحميل الملف مرة اخرى وارني صورة لما تقوله .

تفضل هذا التعديل Dim fso As New FileSystemObject If fso.FolderExists(Environ("USERPROFILE") & "\Desktop\" & "\Folder2") Then Else fso.CreateFolder (Environ("USERPROFILE") & "\Desktop\" & "\Folder2") End If DoCmd.RunSavedImportExport "export" fso.CopyFile Environ("USERPROFILE") & "\Desktop\" & "Folder2\Table1.xlsx", True

ظبط معي استاذي الفاضل ابو جودي ممتاذ

استخدم Environ("USERPROFILE") & "\Desktop\" & fldrname

جزيت خيراً أخي lionheart نعم اعتذر كتب الرقم بالخطأ، تم تعديله. الكود يعمل بشكل صحيح، وعند تجربته لبيانات بها مئات الصفوف يعمل الكود ببطئ ويتطلب وقت أطول بكثيير ، هل يمكن تسريعه؟ في حالة كانت البيانات أكثر من ألف صف؟

Please be precise when posting a question as the rgb values should be 225 not 255 Sub Test() Dim r As Long, m As Long, cnt As Long Application.ScreenUpdating = False m = Cells(Rows.Count, 1).End(xlUp).Row For r = m To 2 Step -1 If Cells(r, 1).Interior.Color = RGB(225, 225, 225) Or Cells(r, 1).Interior.Color = RGB(192, 192, 192) Or (Cells(r, 1).Value = "" And Cells(r, 2).Value = "") Then Cells(r, 1).Resize(1, 2).Delete Shift:=xlUp cnt = cnt + 1 End If Next r Application.ScreenUpdating = True MsgBox "There Are " & cnt & " Rows Deleted", 64 End Sub

Try to make a cell like M1 non-empty and modify the code Private Sub Worksheet_SelectionChange(ByVal M2 As Range) If Range("M1").Value = "" Then ActiveSheet.Cells.Interior.ColorIndex = 0 M2.EntireRow.Interior.ColorIndex = 6 End If End Sub

اخي الكريم استخدم هذا الامر Private Sub TextBox1_Change() Range("a1").Value = TextBox1.Value End Sub ليكن مثلا ان قيمة التكست المطلوب مرتبطه بالخلية A1 ,G;L HGA;V

اخوي محمود ارجع واقرأ ما كتبت لك .. طريقتك هذه خطأ X خطأ ,,, وهذا لا يعني انه لا يمكن التطبيق .. ولكني هنا في منبر تعليمي كتبت لك وعلمتك حفظك الله ورعاك : 1- استخدم جدول واحد 2- اضف عمود جديد قيمته (0/1) 3- في نموذج المشتريات يظهر اللي قيمته صفر وفي نموذج المبيعات يظهر اللي قيمته 1 4- اذا اردت تبيع بالجملة فقط اعمل تحديث للحقول من صفر الى واحد

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

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

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