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

كل عام و انتم بخير

برنامج_مخازن_جديد.xlsm

السلام عليكم مثلا أنا عندى 4 أجهزة فى المنزل فى كل دور جهاز هل يمكن عن طريق الأكسس من اى جهاز منهم عمل ريستارت او اغلاق لجهاز اخر ؟ ملاحظات : المطلوب بدون تصريحات الأدمن بدون برامج خارجية عن طريق الأكواد فقط دمتم بخير

اعتقد استاذ شيفان انه للاستاذ محمد ايمن وبالرابط السابق للاستاذ ابو خليل

هذه فكرة بدائية Private Sub أمر196_Click() Me.rasael_custmer.SetFocus For i = 1 To 50 If IsNull(Screen.ActiveControl) Then x = MsgBox(Screen.ActiveControl.Name, , Me.rasael_custmer!IDr): Exit For: Me.أمر196.SetFocus SendKeys "{tab}" DoEvents Next End Sub بالتوفيق

اليك هذا الماكرو Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$O$2" Then If Target <> "" Then Range("i2") = Format(Now, "d/m/yyyy >>>hh:mm:ss") _ Else Range("i2") = "" End If Application.EnableEvents = True End Sub

استأذن من استاذنا @ابوخليل و @رمهان لا اعرف هذه الاكواد من صتع اي من اخواننا اولا سيعمل لك فولدر باسم باك اب في قرص دي وايضا يعمل باك اب للجداول والعلاقات اتفضل اليك الصق هذا في وحدة نمطية Option Compare Database Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long Public Function ExportNew(myfile As String) ' إنشاء ملف جديد Dim wrkDefault As Workspace Dim dbsNew As Database Dim mydb On Error GoTo gv mydb = Dir(myfile) If mydb = "" Then Set wrkDefault = DBEngine.Workspaces(0) Set dbsNew = wrkDefault.CreateDatabase(myfile, dbLangArabic) Call exportTbl(myfile) GoTo gv1 Else Call exportTbl(myfile) GoTo gv1 End If gv: Resume gv1: End Function Public Function exportTbl(myfile As String) 'تصدير نسخة لجميع الجداول الموجودة' Dim tdfCurr As TableDef Dim strBackupDatabase As String strBackupDatabase = myfile For Each tdfCurr In CurrentDb().TableDefs If (tdfCurr.Attributes And dbSystemObject) = 0 Then DoCmd.TransferDatabase acExport, "Microsoft Access", _ strBackupDatabase, acTable, tdfCurr.Name, _ tdfCurr.Name End If Next tdfCurr End Function Function ExportRelations(DbName, DbName2 As String) As Integer 'الحاق العلاقات بالجداول المنسوخة Dim ThisDb As dao.Database, ThatDB As dao.Database Dim ThisRel As dao.Relation, ThatRel As dao.Relation Dim ThisField As dao.Field, ThatField As dao.Field Dim Cr As String, i As Integer, cnt As Integer, RCount As Integer Dim j As Integer Dim ErrBadField As Integer Cr$ = Chr$(13) RCount = 0 Set ThisDb = DBEngine.Workspaces(0).OpenDatabase(DbName2) Set ThatDB = DBEngine.Workspaces(0).OpenDatabase(DbName) For i = 0 To ThatDB.Relations.Count - 1 Set ThatRel = ThatDB.Relations(i) Set ThisRel = ThisDb.CreateRelation(ThatRel.Name, _ ThatRel.Table, ThatRel.ForeignTable, ThatRel.Attributes) ErrBadField = False For j = 0 To ThatRel.Fields.Count - 1 Set ThatField = ThatRel.Fields(j) Set ThisField = ThisRel.CreateField(ThatField.Name) ThisField.ForeignName = ThatField.ForeignName On Error Resume Next ThisRel.Fields.Append ThisField If Err <> False Then ErrBadField = True On Error GoTo 0 Next j If ErrBadField = True Then Else On Error Resume Next ThisDb.Relations.Append ThisRel If Err <> False Then Else RCount = RCount + 1 End If On Error GoTo 0 End If Next i ThisDb.Close ThatDB.Close ExportRelations = RCount End Function Public Sub autobackup() Dim datefile As Date Dim timefile As Date Dim pro As String datefile = Date timefile = Time pro = Mid(CurrentProject.Name, 1, (Len(CurrentProject.Name) - 4)) & " " & _ Format(datefile, "yyyy-mm-dd") & " " & Format(timefile, "hh-nn-ss") Path = "D:\Backup\" x = Path Select Case x End Select MakeSureDirectoryPathExists Path & "\" Call ExportNew(x & "\" & pro & ".dat") Call ExportRelations(CurrentProject.FullName, x & "\" & pro & ".dat") MsgBox "تم انشاء نسخة احتياطية بشكل آلي بنجاح في المسار" & vbCrLf & "D:\Backup\", vbInformation End Sub وفي نموذج خلف زر اكتب هذا Call autobackup

السلام عليكم ا.ناصر ماذا تقصد ب .. محدد مدي المسح ..؟؟؟

اهلا بك اخي @Ahmed.IQ اتفضل اليك هذا If DCount("*", "MsysObjects", "[Name]='table1'") > 0 Then MsgBox "الجدول موجود" Else MsgBox "الجدول غير موجود" End If غير table1 باسم جدولك تقبل تحياتي

::: تفضل اخي .. طريقة اخرى.... اتمنى لك التوفيق ::: @Shivan Rekany Thanx ادارة التعليم الإبتدائي بالبحر الأحمر.rar

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

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

السلام عليكم جرب المرفق علة المطلوب ترحيل من شيت الى شيت اخر واظهار بعض الفقرات تلقائيا.rar

جرب هذا الحل وأخبرني بالنتيجة رمضان مبارك

بارك الله فيك

::: هل تقصد نموذج رابع يحوي الثلاثة احدهما فوق بعض ويتم التبديل بينهما بوسطة صندوق خيارات ؟ . ::: تفضل قد يكون هذا طلبك .... بالتوفيق . Db 31_UP.rar

اسعد الله اوقاتكم وكل عام والجميع بالف خير بنسبه للحفظ انا اطبق فكرة الاستاذ الكبير كمال النحال وهي كالتالي 1- وضع حقل في الجدول يكون نوع البيانات نعم /لا ويكون القيمة الإفترضية False 2- انشاء استعلام حذف يقوم بحذف اي سجل يكون فيه القيمة False 3- في زر الحفظ تغيير قيمة الحقل من False الى true 4- وضع كود تشغيل استعلام الحذف عند اغلاق النموذج وبالتالي عند الخروج من الشاشة راح يقوم الاستعلام بالبحث عن السجلات التي تحمل القيمه False وتقوم بحذفها ان شالله تفي معك الفكره بالغرض

بعض ما عندكم أخي العزيز

شكرا لك @أ / محمد صالح على الشرح الوافي الكافي

كما أخبر أستاذ @Shivan Rekany هذا حل عدم ظهور اللغة العربية بصورة صحيحة في محرر الفيجوال بيسك وبالنسبة لرسالة الخطأ الظاهرة ربما لعدم وجود المكتبات DLL المطلوبة في الملف وربما بسبب مشكلة اللغة وعلاج المكتبات من قائمة tools نختار references ستظهر نافذة ومكتوب بجانب بعض المكتبات missing يعني مفقود ولك فيها حلان تحميل ملفات DLL الناقصة أو الاستغناء عنها إذا استمر عمل البرنامج بدونها وفقنا الله وإياكم لكل خير

الله يعطيك العافية يعني احتمالية الاكبر يرجع الى اعدادات اقليمية ضبط اعدادات جهازك حسب اعدادات بلدك اي من لوحة التحكم كونترول بنال ثم الاعدادات الإقليمة و اللغة ثم خيارات متقدمة ثم تحدد اللغة العربية

هل عند فتح برامج اكسس جديد بيعطيك هذه الرسالة ؟ اذا لا تأمكد من مكتبات المطلوبة

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

السلام عليكم كل عام وانتم بخير بمناسبة شهر رمضان الكريم بحثت فى المنتدى عن كود لعمل ريستارت و اغلاق للجهاز و تغيير للمستخدم Logoff وجدت الكود ولكنه لا يعمل فى حالة تغيير المستخدم ويعمل فى باقى الحالات الاغلاق واعادة التشغيل فما السبب ؟. الكود Shell "shutdown -l -t 02", vbHide جزاكم الله خير

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

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

مش شغال لأن الشرط متحققش فى الجدول فى الحقل amr غير كلمة تم الى اى شئ وافتح النموذج هيشتغل تمام جرب وقولى بالظبط استاذ شيفان هذا الكود اللى موجود بالمرفق الثانى مشكور على مرورك

طيب مش شغال ازاى وبتتكلم على المرفق الاول ولا التانى ؟

ههههه تلاقيك اوفيس 64 صح ؟

لا ولا خدعونى ولا اى شئ انتا استاذنا طبعا ووشك حلو كمان لقيت الحل لوحدى شوف المرفق شغال زى الفل مشكور اخى الكريم amr.rar

انتا استاذنا ياباشا انتا عارف بنتعلم منك ومتزعلش دى القاعدة اللى طبقت عليها الاكواد كله شغال الا Logoff هتلاقى فى Comments الاكواد شغل الكود اللى تحبه كله شغال الا Logoff بس يعنى بيعمل ريستارت وبيطفى الجهاز انما مش بيعمل Logoff تقبل تحياتى ShutDown.rar

بارك الله فيك أخي الغالي زيزو العجوز .. كود رائع واستخدام أروع للدالة CHOOSE في تحديد الأعمدة المطلوب ترحيلها .. جزاك الله خير الجزاء على كل ما تقدمه لإخوانك تقبل وافر تقديري واحترامي

السلام عليكم ورحمة الله تم التعديل وتم تجريب الكود بعد عمل صفحة جديدة غير محمية حيث لم اتمكن من التجربة فى المرات السابقة اليك الكود Sub TransKinds() Dim ws As Worksheet, sh As Worksheet Dim Arr As Variant, Temp As Variant Dim i As Long, j As Long, p As Long Dim Kname As String Set ws = Sheets("حركة اليوميه") Set sh = Sheets("كارت الصنف") Kname = sh.Range("F2").Value Application.ScreenUpdating = False Arr = ws.Range("D5:O" & ws.Range("F" & Rows.Count).End(xlUp).Row).Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 3) = Kname Then p = p + 1 For j = 1 To 10 Temp(p, j) = Arr(i, Choose(j, 1, 4, 3, 6, 7, 8, 9, 10, 11, 12)) Next End If Next If p > 0 Then sh.Range("E5").Resize(p, UBound(Temp, 2)).Value = Temp Application.ScreenUpdating = True End Sub

تحت امرك اخى الكريم ثانيا بالنسبة للويندوز كما أشار الأستاذ جعفر فى موضوعه ان لا يجب ان يكون الاوفيس 64 لما يكون الويندوز 64 بل يمكن تسطيب اوفيس 32 على ويندوز 64 بطريقة عادية انا ويندوز 64 ومسطب اوفيس 2016 32 بيت ويعمل بكفاءة الحمدلله فبالتالى يمكنك تسطيب النسخة 32 بدون مشاكل ان شاء الله وستمنع الكثير من العقبات