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

السلام عليكم برنامج محاسبة الشركات اهداء لكم برنامج محاسبة الشركات الاصدار الرابع سلوم 0787787573.rar

احسب عمرك معرفة عمرك بالسنين و الشهور و الأيام.xlsx

وعليكم السلام 🙂 يمكنك فتح نموذج في برنامج آخر ، هكذا : Private Sub cmd_View_Kids_info_Click() On Error GoTo err_cmd_View_Kids_info_Click 'From Personnel Application, open sfrm_Family 'if the Remote Application/Form is open, close it first appAccess.DoCmd.Quit 'now open the Form for the new Employee_ID Set appAccess = CreateObject("Access.Application") DB_Path = "\\DBs\FE\Finance_FE.accdb" appAccess.OpenCurrentDatabase (DB_Path) appAccess.DoCmd.OpenForm "sfrm_Family" appAccess.Visible = True appAccess.UserControl = True 'Set appAccess = Nothing Exit_cmd_View_Kids_info_Click: Exit Sub err_cmd_View_Kids_info_Click: If Err.Number = 91 Or Err.Number = 462 Then 'the application is NOT open, ignore the error Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub . ويمكن ان نفتح النموذج اعلاه للقراءة فقط: Private Sub cmd_View_Kids_info_Click() On Error GoTo err_cmd_View_Kids_info_Click 'From Personnel Application, open sfrm_Family 'if the Remote Application/Form is open, close it first appAccess.DoCmd.Quit 'now open the Form for the new Employee_ID Set appAccess = CreateObject("Access.Application") DB_Path = "\\DBs\FE\Finance_FE.accdb" appAccess.OpenCurrentDatabase (DB_Path) appAccess.DoCmd.OpenForm "sfrm_Family", , , , acFormReadOnly appAccess.Visible = True appAccess.UserControl = True 'Set appAccess = Nothing Exit_cmd_View_Kids_info_Click: Exit Sub err_cmd_View_Kids_info_Click: If Err.Number = 91 Or Err.Number = 462 Then 'the application is NOT open, ignore the error Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub . كما يمكن ان نفتح النموذج اعلاه للقراءة فقط ، مع تصفية : Private Sub cmd_View_Kids_info_Click() On Error GoTo err_cmd_View_Kids_info_Click 'From Personnel Application, open sfrm_Family 'if the Remote Application/Form is open, close it first appAccess.DoCmd.Quit 'now open the Form for the new Employee_ID Set appAccess = CreateObject("Access.Application") DB_Path = "\\DBs\FE\Finance_FE.accdb" appAccess.OpenCurrentDatabase (DB_Path) myWhere = "[Full_Name]='" & Me.frm_1_All!Full_Name & "'" myWhere = myWhere & " And [Relation]<>'زوجة'" myWhere = myWhere & " And [Relation]<>'زوج'" appAccess.DoCmd.OpenForm "sfrm_Family", , , myWhere, acFormReadOnly appAccess.Visible = True appAccess.UserControl = True 'Set appAccess = Nothing Exit_cmd_View_Kids_info_Click: Exit Sub err_cmd_View_Kids_info_Click: If Err.Number = 91 Or Err.Number = 462 Then 'the application is NOT open, ignore the error Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر

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

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

مش عاوزه تشتغل عندى

@sandanet اخي الكريم, لم نتشعب في الموضوع لكن ربما لم تتضح لك الصورة لحد الان مهما تبرمج من خوارزمية او حماية وتبقى نسخة القاعدة نسخة مفتوحة يعني ليست ACCDE أو MDE فكل برمجتك وحمايتك لا معنى لها ركز في هذه الكلمة ( لا معنى لها ) , ببساطة يأتي شخص ويقوم بحذف الكود المسؤول عن التحقق والحماية وكل شي سوف ينتهي معها ارجو ان تكون توضحت الصورة لديك

ايه رأيك يا استاذى الجليل ومعلمى القدير الاستاذ @SEMO.Pa3x أن يتم إرسال ذلك اولا للعميل بدلا من ملف VBS HWND.zip

عليكم السلام. طلبك ممكن وبكل بساطة. اولا: الطريقة الاولى بدون Windows API Dim cmgr As String cmgr = "مسار البرنامج الذي تريد تشغيله" 'مثال '‪cmgr = "C:\WINDOWS\system32\mspaint.exe" Call Shell(cmgr, vbMaximizedFocus) ثانياً: الطريقة الثانية بإستخدام Windows API بواسطة دالة ShellExecuteA Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _ ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _ ByVal lpDirectory As String, ByVal lpnShowCmd As Long) As Long Public Sub ShellEx(ByVal Path As String, Optional ByVal Parameters As String, Optional ByVal HideWindow As Boolean) If Dir(Path) > "" Then ShellExecute 0, "open", Path, Parameters, "", IIf(HideWindow, 0, 1) End If End Sub 'run executable ShellEx "c:\mytool.exe" 'open file with default app ShellEx "c:\someimage.jpg" 'open explorer window ShellEx "c:\" هذا شرح مفصل عنها https://www.vb-helper.com/howto_shellexecute.html

@qathi @ابا جودى ممكن تعطوني ارقام الماك ادريس الخاصة بكم ثم حملو القاعدة الاتية. ملاحظة القاعدة لن تفتح معكم, إلا ان قمت انا بوضع الماك ادرس الخاص بكم في قاعدة البيانات الخاصة بي بعدها ستعمل القاعدة معكم بدون مشاكل ، وفي اي لحظة اقوم بها بحذف اي ماك ادريس منكم وليكن مثلا قمت بحذف ماك ادريس @ابا جودى فلن يستطيع استخدام القاعدة مرة اخرى. Protection.rar

جرب هذا الكود Option Explicit Sub HID_COLUMNS() Dim I% Range(Cells(1, 5), Cells(1, 262)).EntireColumn.Hidden = True For I = 13 To 262 Step 8 Cells(1, I).EntireColumn.Hidden = False Next End Sub

تفضل مع الأخذ فى الإعتبار أنه لن يتم إخفاء النموذج المفتوح HideUnhide.accdb

اذا كان الرقم عدد الارقام ثابت استعلام 2 Expr1: Right([Girlid];8) اذا كان غير ثابت استعلام 3 Expr1: Right([Girlid];Len([Girlid])-1) استعلام 3 يكفي في جميع الحالات test2.accdb

هو معرف فريد لجهازك تولده خوارزمية خاصة بنظام التشغيل تقرأ بعض قطع الجهاز لتكون صيغة فريدة يتم الرجوع اليها في بعض البرامج (كلام مش مفهوم) هههه .. مايهمنا هو هل يتغير ام لا

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

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

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

السلام عليكم بالتوفيق استاذ @عبد اللطيف سلوم تقبل تحياتى طبتم واهتديتم

اتفضل (02) متابعة غياب طلاب الفراغات.zip

السلام عليكم تفضل D_n.xlsm

السلام عليكم ورحمة الله وبركاته فورم إضافة وبحث وتعديل مرن (الاصدار الثالث) بمعية فورم لادخال التاريخ الجديد في هذا الاصدار 1 - امكانية اضافة التاريخ في تاكست الادخال بوضع مؤشر الفارة على التاكست والضغط عل الزر Calendar 2 - اضافة زر اختيار للبحث للتبديل بين البحث العام والبحث من بداية الكلمة 3 - اضافة زر للذهاب الى السجل النشط شرح امكانيات الفورم وكيفية الاستخدام 1 - استخدام الفورم لاكثر من قاعدة بيانات في المصنف على ان يكون لكل قاعدة كود لاظهار الفورم يتغير فيه معطياتك في متغيرات kh_SetAddrss اولاً : اسم ورقة البيانات ( افتراضي ) ثانياً : نطاق صف رؤوس اعمدة البيانات ( افتراضي ) ثالثاً : عمود التسلسل ( اختياري ) اذا اردت ادخال رقم تسلسل البيانات الخاص بالفورم تلقائيا في عمود معين سجل عنوان راس العمود . مع ملاحظة انه لا يكون من ضمن نطاق رؤوس اعمدة البيانات كما هو معمول في المثال 2. 2 - تستطيع اضافة قائمة لعمود معين في الفورم باضافة تعليق على عنوان العمود وتكتب اسم نطاق القائمة . 3 - ينسخ التنسيقات والمعادلات في السجل الجديد . 4 - يبحث في جميع الاعمدة حسب الاختيار من القائمة في الفورم . 5 - يعطي نتائج صحيحة عند البحث عن تاريخ اذا شيكت الزر البحث عن تاريخ . 6 - امكانيات زر البحث عن تاريخ يتم تحويل اي قيمة تضعها في مربع النص للبحث الى تاريخ بالتنسيق الافتراضي للفورم ,, مع امكانية ادخال رقم صحيح بين 1 الى 31 ليفهم على انه تاريخ اليوم للشهر الحالي والسنة الحالية 7 - ثوابت بامكانك تغييرها حسب طلبك بداية اكواد الفورم 1- تغيير تنسيقات إظهار التاريخ في الفورم في الثابت DtF 2- تغيير عٌرض مربعات الادخال في الثابت iWgt1 8 - بامكانك انتقاء الاعمدة التي تريدها عند تسمية النطاق وترتيبها حسب ما تريد مع ملاحظة ان العمود الذي يعتمد عليه في احتساب آخر صف هو العمود الاول من التسمية مثلا "E15,C15,H15:AX15" الشرح بداخل الملف للاستخدام يجب نقل الفورمين الى ملفك المرفق 2003 فورم ادخال و تعديل مرن بمعية فورم ادخال التاريخ.rar ============================================ تم اضافة زر للطباعة في الرابط ادناه http://www.officena.net/ib/index.php?showtopic=52300 ============================================

وهذا هو التعديل المناسب الاسماء تظهر حسب الحصص جرب ووافنى بالنتيجة (01) متابعة غياب طلاب الفراغات.zip

دعني اشرح لك الذي فهمته من خوارزميتك. 1- قمت بإحضار volume serial number ( الرقم التسلسلي ) 2- طلبت ان يتم ابقاء اول 3 محارف من الرقم 3- طلبت يتم جمع الرقم الناتج مع ( 95312876 ) 4- ثم رجعت الى مربع البداية الى الرقم volume serial number الاصلي قبل التعديل عليه وقمت بطرحه من الرقم الذي نتج بعد جمعه مع ( 95312876 ) 5- بعدها ضربت الناتج * 2

هل هذا يكفي ؟

تفضل ولاكن لايمكن العمل على التخمين بدون رفع ملف العمل Book1 (Recovered).xlsm

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

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

استاذنا @sandanet ده كان طلب الزبون 😃 وعلى قد ما عرفت بقى لكن ان شاء الله ندمج الفكرتين مع بعض خاص تحياتى لشخصك الكريم

طيب بما ان دى كمان صارت مشكلة لانها تعمل على اجهزة دون الاخرى لا يمكننا لا الاعتماد عليها فى تأمين القاعدة لانها تستوجب وجود الانترنت على جهاز العميل كما ان فكرة الاستاذ @SEMO.Pa3x كذلك تعتمد على اتصال الحاسوب بشبكة الانترنت وقد يسبب ذلك مشكلة عند بعض العملاء الذين لا يملكون الانترنت او حتى الاتصال بشبكة محلية لقرآة الماك ادرس اتمنى تجربة المرفق الاتى وابداء الآراء Security My App (v.01).mdb.zip

أرجو أن يكون المطلوب Database.rar

السلام عليكم تفضل المرفق بيان الحالة1.xlsm

الخلل انك قمت بوضع مسافات ( Space ) قبل وبعد كلمة ( حاضر / غائب ) " غائب " " حاضر " لاحظ المسافات قبل الكلمة وبعدها, احذف المسافات او قم بعمل التنسيق الشرطي مع المسافات وسيعمل بشكل جيد حسنين متابعة غياب طلاب الفراغات.mdb

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

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

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

بعد اذن استاذى الجليل ومعلمى القدير الاستاذ @essam rabea وزيادة فى الخير قد تعجبك الافكار ان شاء الله بهذا المرفق https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=166769

هذه المعادلة في الحلية C4 واسحب نزولاً =MAX($A$4:$A$10000)+ROWS($C$4:C4)

جرب الملف المرفق .. ميزة الطريقة الموجودة في المرفق هي عند اخفاء الجداول فلايمكن اظهارها من خلال خيارات العرض في قاعدة البيانات "إظهار الكائنات المخفية" كما لايمكن استيراد الجداول ايضاً example1.accdb

@ابا جودى جزاك الله كل خير عمل متقن ورائع.

أساذنا ابا جودى فكرة جديرة بالإحترام .. ابتديت أشك انك كيميائى

شكراً يا ابا الجود وبارك الله بك

السلام عليكم اساتذتى الكرام اود ان اقدم لكم اليوم دالة أعجبتنى -وتقوم هذه الدالة بتحويل التقويم الميلادى الى التقويم القبطى ومن هنا لابد ان نعرف التقويم القبطى ولابد ان نقول نبذة عنه تبدأ السنة الجديدة عادة في 29 أغسطس، عدا السنة التي تسبق السنة الكبيسة حيث تبدأ في 30 أغسطس. للحصول على رقم السنة القبطية، يُطرح من رقم السنة اليوليانية إما 283 (قبل السنة اليوليانية الجديدة) أو 284 (بعدها). ويتكون التقويم القبطى من 13 شهر كالتالى : وهذا هو كود الدالة المستخدمة فى تحويل التاريخ من الميلادى الى القبطى Option Explicit Function CopticDate(WkDate As Date) As String Const YDiff = 284 Dim DateList As Object Set DateList = CreateObject("System.Collections.Sortedlist") Dim T, TT Dim I As Integer, II As Integer Dim WkY As Integer Dim WkM As String Dim WkD As Integer With Sheets("Data") For I = 1 To 13 T = Split(.Cells(I + 1, 3), "/") DateList.Add DateSerial(Year(WkDate), T(1), T(0)) * 1, .Cells(I + 1, 4) Next I End With WkY = Year(WkDate) - YDiff With DateList TT = WkDate * 1 If (TT >= .GetKey(.Count - 1)) Then WkM = .GetByIndex(0) WkD = TT - .GetKey(.Count - 1) + 1 Else If (TT <= .GetKey(0)) Then WkM = .GetByIndex(.Count - 1) II = TT - DateSerial(Year(WkDate), 1, 1) ' FIRST day of the year = 101 WkD = DateSerial(Year(WkDate), 12, 31) - .GetKey(.Count - 1) + II ' LAST day of the year = 1231 Else For I = 0 To 12 If ((TT > .GetKey(I)) And (TT <= .GetKey(I + 1))) Then WkM = .GetByIndex(I + 1) WkD = TT - .GetKey(I) Exit For End If Next I End If End If End With CopticDate = WkM & "/ " & WkD & "/ " & WkY End Function وتستخدم بهذه المعادلة =CopticDate() convert the Christmas calendar to the Coptic calendar.xlsm

اذهب لاعدادات واجهة الاكواد Alt+F11 ثم القائمة Tools ثم Options ثم Editor Format وغير لغة الـ Font الـى Courier New (العربية) امل ان يعمل معك هذا بخصوص الاكسل

السلام عليكم يوجد كود عمل قائمه باسماء الصفحات وعمل هايبر لينك باسم الصفحه وهيبر لينك داخل الصفحات بالعوده الي الصفحه الرئيسيه لكن الهيبر لينك لا يعمل في حاله اخفاء الصفحات المطلوب عند الضغط علي اسم الصفحه المخفيه يعمل الكود وعند الضغط علي كلمه الرئيسيه يخفي الصفحه والعوده الي الصفحه الرئيسيه شكراNew Microsoft Excel Worksheet.xlsx

جرب هذا الماكرو Option Explicit Dim check% Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Columns(1)) Is Nothing _ And Target.Count = 1 Then Call IsHyperlink(Target) If check Then Sheets(Target & "").Visible = True Target.Hyperlinks(1).Follow End If End If Application.EnableEvents = True End Sub Sub IsHyperlink(r As Range) check = r.Hyperlinks.Count End Sub الملف مرفق للتجربة TEST_HYPER.xlsm

الملف الذي رفعته لا يحتوي على اي كود انه بصيغة xlsx و لكن اليك الكود المناسب لهذا الأمر Option Explicit Sub ADD_SH_with_Hyper() 'code to add Sheets One Time WITH HYPERLINKS 'Crated By Salim Hasbaya On 7/10/2019 Dim Rg As Range Dim sh As Worksheet Dim LA%, i% Set sh = Sheets("SALIM") LA = sh.Cells(Rows.Count, 1).End(3).Row For Each Rg In sh.Range("A2:A" & LA) If Rg.Value <> "" Then If Not Application.Evaluate("ISREF('" & Rg.Value & "'!A1)") Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = Rg.Value With ActiveSheet .Hyperlinks.Add Anchor:=.Range("c2"), Address:="", SubAddress:= _ "SALIM!A1", TextToDisplay:="Goto SALIM" .Columns(3).AutoFit End With End If End If Next Rg With Sheets("SALIM") .Hyperlinks.Delete For i = 2 To LA .Hyperlinks.Add Anchor:=.Range("A" & i), Address:="", SubAddress:= _ .Range("A" & i) & "!A1", TextToDisplay:=.Range("A" & i).Value Next .Select End With End Sub الملف مرفق create_sh_with_hyperxlsx.xlsm

بسم الله الرحمن الرحيم الأستاذ الفاضل محمد طاهر فكرة رائعة في هذا المنتدى الرائع يشرفني و يسعدني التواصل مع أعضاء هذا المنتدى الذي أصبح جزءاً ثابتاً في برنامجي اليومي أخوكم في الله الاسم : نادر عبد الرحمن عبد الله الميلاد : 25 من فبراير سنة 1962 م الجنسية : مصري الإقامة : مصر - محافظة الشرقية - بقرية اسمها العزيزية تابعة لمدينة منيا القمح البريد الإلكتروني : naderwatfa@yahoo.com الحالة الاجتماعية : متزوج و معي ثلاثة أبناء ( الأكبر: عبد الرحمن ثم بنتان : دينا و نادين ) العمل : معلم أول لغة عربية بالمرحلة الإعدادية خبرتي في العمل : بجانب التدريس القيام بكل أعمال كنترول الامتحانات و الجدول المدرسي قبل ذلك الهوايات : الموسيقى ( سماع و عزف على العود و البيانو ) - القراءة - و أكيد الكمبيوتر الاهتمام في المنتدى : الإكسيل و تطبيقاته و تنسيقاته ( قمت بعمل بعض برامجه و أهمها برنامج كنترول شيت امتحانات النقل حيث أحتاجه في عملي )

السلام عليكم ورحمة الله وبركاته الاسم : عبدالله علي أحمد باقشير الميلاد : 04/ 12 / 1967 الجنسية : يمني المؤهل : ثانوية عامة العمل : قطاع خاص( محاسب) الهوايه : الاكسل تحياتي