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

اليك هذه الوحدة النمطية ... في الحقيقة لا اعرف من هو صاحب الكود Private Const NV_CLOSEMSGBOX = &H5000& Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, _ ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _ ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, _ ByVal nIDEvent As Long) As Long Private mTitle As String Private mPause As Long Private mHandle As Long Public Function MsgBoxPause(ByVal hwnd As Long, ByVal inPrompt As String, _ ByVal inTitle As String, ByVal inButtons As Long, _ ByVal inPause As Integer) As Integer mTitle = inTitle: mPause = inPause * 1000 SetTimer hwnd, NV_CLOSEMSGBOX, mPause, AddressOf NewTimerProc MsgBoxPause = MessageBox(hwnd, inPrompt, inTitle, inButtons) End Function Public Function NewTimerProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wparam As Long, _ ByVal lparam As Long) As Long KillTimer hwnd, wparam If wparam = NV_CLOSEMSGBOX Then mHandle = FindWindow("#32770", mTitle) If mHandle <> 0 Then SetForegroundWindow mHandle SendKeys "{enter}" End If End If End Function وفي النموذج تكتب هكذا او تقدر تعمل زر لهذا الامر Option Compare Database Private Sub Form_Load() Dim s As Integer s = 5 ' عدد الثواني mResult = MsgBoxPause(hwnd, "الرجاء انتظار " & s & " ثواني . ", _ "العنوان", vbOKCancel + vbExclamation + vbDefaultButton2 + vbMsgBoxRight + vbMsgBoxRtlReading, s) End Sub اليك القاعدة اخفاء الرسالة بعد ثواني محددة.accdb

انا اضفت حقل اخر باسم itemType1 في جدول ItemsT وبيأخذ قيمة رقم نوع الصنف * ملاحظة : تقدر ان تعطي قيمة افتراضية في النموذج الادخال وبعدين في استعلام مصدر الليست بوكس عملت علاقة بين الجدولين وبعدين حذفت الحقل نوع الصنف و اضفت من جدول اسم المنتج من جدول الاصناف القي نظرتا الى الاستعلام اي مصدر ليست بوكس

لا توجد اي طريقة غير اخفاء الجداول وتشفير البيانات فقط بالنسبة لموضوع التشفير انظر الرابط التالي :: بالتوفيق::

كما تفضل استاذ @ابو ياسين المشولي تقدر تستخدم شريط تقدمي و دورت على جهازي وتم الحصول الى هذا و اهديك لكن لا اعرف من هو صاحبه ,,,, الله يحفظه شريط تقدمي.mdb

جرب هذا الملف دمج ثلاثة أعمدة فى عمود واحد.xlsm

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

راجع هذا لعله كما طلبك https://www.officena.net/ib/topic/85516-مؤشر-تحميل-لاستخدمه-بفتح-التقارير/

احبائي اعضاء المنتدى اوفيسنا السلام عليكم ورحمة الله وبركاته في هذه الاونة الاخيرة اشوف ان كثير من احبائنا بيسئلون عن ضغط و اصلاح و نسخ الاحتياطية لذلك قمت بدمج موضوعين واحد للسيد @أبو إبراهيم الغامدي والسيد @أ / محمد صالح وتم اضافة ملح و و بهارات شوية واهديكم ....... الى الموضوع هناك نموذجين بداخل القاعدة واحد اسمه Frm1 والاخر Form1 وفي نموذج Form1 هناك زرين الاول كتبت عليه ( قم بعمل كومباكت و نسخة احتياطية عند الاغلاق ) اي اذا ضغطت علي و في النهاية قمت باغلاق القاعدة اولا سيعمل نسخة احتياطية و بعدين سيعمل كومباكت اي ضغط و اصلاح القاعدة -------- اما الزر الثاني انا كتبت عليه ( الغي عمل كومباكت و نسخة احتياطية عند الاغلاق ) اي اذا ضغطت على الزر الاول وبعدين غيرت رأيك بعمل نسخة احتياطية او عمل كومباكت اي ضغط واصلاح القاعدة تقدر ان تضغط اليه واذا اغلقت القاعدة ما بيعمل كمباكت و نسخة الاحتياطية واستخدمنا هذه الاكواد في وحدة نمطية Option Compare Database Dim F As New Form_Frm1 Public Function Startup() On Error Resume Next F.OnClose = "=BackUpMyDb()" & "=CopactMyDb()" End Function Public Function CnacelStartup() On Error Resume Next F.OnClose = "" End Function Public Function BackUpMyDb() Dim MyPath As String, math1 As String, math2 As String math1 = CurrentProject.Path math2 = math1 & "\MyProg" MyPath = math2 & "\BackUpSaved" On Error GoTo MyErr Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, CopyMyDB, TypeApp OldFile = CurrentDb.Name DBwithEXT = Dir(OldFile) If Right(DBwithEXT, 5) = "accdb" Then DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6) TypeApp = ".Accdb" ElseIf Right(DBwithEXT, 3) = "Mdb" Then DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4) TypeApp = ".Mdb" End If If Dir(math2, vbDirectory) = "" Then MkDir math2 If Dir(MyPath, vbDirectory) = "" Then MkDir MyPath NewFile = MyPath & "\" & DBwithoutEXT & "-" & Format(Now, "yyyy-mm-dd-Hh-Nn-Ss") & TypeApp CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If End Function Public Function compactDb(ByVal mydb As String, ByVal mypass As String, Optional openIt As Boolean = False) Dim F As Integer Dim filenoext As String, extension As String, Access As String Access = """" & SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE""" filenoext = Left(mydb, InStrRev(mydb, ".")) extension = Right(mydb, Len(mydb) - InStrRev(mydb, ".")) F = FreeFile Open CurrentProject.Path & "\compact.bat" For Output As F 'wait until the Db closes (ldb file is gone), then compact it Print #F, "CHCP 1256" Print #F, ":checkldb1" Print #F, "if exist """ & filenoext & "l" & extension & """ goto checkldb1" Print #F, Access & " """ & mydb & """" & mypass & " /compact" If openIt Then 'wait until the Db closes, then start it Print #F, ":checkldb2" Print #F, "if exist """ & filenoext & "l" & extension & """ goto checkldb2" Print #F, Access & " """ & mydb & """" Else Print #F, "del ""%~f0""" End If Close F End Function Public Function CopactMyDb() On Error Resume Next Dim MyPath As String MyPath = CurrentProject.Path & "\" & CurrentProject.Name Call compactDb(MyPath, "", True) Shell """" & Left(MyPath, InStrRev(MyPath, "\")) & "\compact.bat""", 0 DoCmd.Quit acQuitSaveAll End Function واليكم القاعدة compactInClose.accdb

دائما شفرات وبهارت الاستاذ شيفان لذيذة ومحبوبة للجميع..

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

أقدم لكم برنامج عمل قوائم فصول يصلح لكل المراحل يتم التعامل به بكل سهولة قوائم.xls

بسم الله الرحمن الرحيم ارفق قاعدة بيانات مدارس باصدار 2003 اريد عمل استعلام يجلب كافة المعلومات من كل مدرسة رواتب المدارس.rar

السلام عليكم اخواني الكرام اليوم اتفاجات بحاجات كثيرة عندما استوردت نماذج من 2003 الى 2010 اولا البحث ما ييشتغل عندي وعملت موضوع بهذا الان اتفاجاء الالحاق ما يشتغل يعطيني خطاء وكمان في بحث تحرير وسرد كنت اكتب اول كلمه ويكمل الباقي والان اتوقف من لديه خبرة لا يبخل علينا هذا كود الالحاق Dim strSQL1 As String strSQL1 = "insert INTO حركات (user,دائن, [تاريخ الحركة], البيان, الاسم,[نوع السند]) VALUES ([Forms].[login]![a],[نص259], snddate ,""دخل""&[supplier], ""الخزينه"",""دخـل"")" DoCmd.RunSQL strSQL1

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

تسلم ايدك وبارك الله فيك

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

يسمح لي أخي عبداللطيف يعمل الآن بدون مضاعفة الملبغ بعد التعديل اقساط معدله.accdb

هل جربت البرنامج مع جهاز الباركود

بعد اذن الاستاذ علي جزاه الله خيرا لاحظ التعديل حسب طلبكم تحياتي برنامج قوائم الفصول++.xls

المشكلة كان يرجع لعدم اختيار مكتبة اوتولوك انا قمت باضافة مكتبة microsoft outlook 14.0 object library والان بيعمل الكود test.accdb

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

تفضل المطلوب لا داعي لكتابة السنة إكسيل يقوم باستخراج السنة استحقاق الاجازة.rar

استاذى الكبير بارك الله فيك واسعد ايامك بكل الخير

جزاك الله الف خير اخي .. واسف ﻷني شكرتك متأخر

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

اتفضل اليك ما طلبت ProgAssit24.rar

تسلم اخي شفان وبارك الله بجهودك القيمة لاكن عندي سؤال : هل من الممكن تغير كد الزر الثاني الذي يحمل عبارة ( الغي عمل كومباكت و نسخة احتياطية عند الاغلاق ) وجعله باستطاعتة استعادة النسخة الاحتياطية . حسب اعتقادي انشاء امر استعادة افضل من انشاء امر الغاء هكذا يكون البرنامج اروع شوية بعد ضيف لها ملح وبهارات اتصير الذ واطعم ياطيب

اتفضل تم اضافة موضوع جديد على هذا اتمنى ان تستفيد منه

أهلا بك اخ كريم فى المنتدى تفضل لك ما طلبت دخول وخروج الموظفين.xlsx

Sub إخفاء_إظهار() On Error Resume Next Dim XX As Shape 'الإعلان عن متغير اسمه Shape (الشكل) Set XX = Sheet1.Shapes("الدائرة") ' ممكن تغيير الاسم الذي باللون الأحمر باسم الشكل الذي قمت بإدراجه ' استدعاء الشكل في شييت1 With XX.TextFrame.Characters If .Text = "إخفاء الصفوف" Then ' اسم الأول الذي تريد إظهاره في الشكل Ahmed_Head ' اسم الماكرو الأول .Text = "إظهار الصفوف" ' الاسم الثاني الذي تريد إظهاره في الشكل Else Ahmed_Show 'اسم الماكرو الثاني .Text = "إخفاء الصفوف" اسم الأول الذي تريد إظهاره في الشكل End If End With On Error GoTo 0 End Sub أتنمى من الله أن يكون هذا المطلوب ويكون واضحًا

بفضل الله توصلت إلى كود إخفاء صفوف بناء على قيمة أنا اخترتها في العمود K إذا كانت القيمة 0 ابتداءًا من الخلية K10وحتى الخلية K125 وعملت كود لإظهار الصفوف المخفية مرة أخرى وطبعًا جعلت الكودين يعملان بزر أمر واحد وبهذا الكود يمكن جعل قيمة الخلية في العمود K رقم 1 مقابل الصف الذي تريد إظهاره جرب الملف زر واحد اخفاء واظهار.zip

تفضل المطلوبزر واحد اخفاء واظهار.zip

شوف المرفق نموذج date01 الاجازات - Copy.rar

السلام عليكم سأحل لك فقط أول سؤال في المرفق الكود التالي في حدث الصفحة الرئيسية وهو يخفي باقي الأوراق كلما رجعت للصفحة الرئيسية الكود Private Sub Worksheet_Activate() For i = 2 To Worksheets.Count Sheets(i).Visible = False Next End Sub السؤال الثاني سأفكر فيه السؤال الثالث ، مش فاهمه ، ياريت توضح أكثر تفضل المرفق به حل أول سؤال فقط دفتر اقساط3.rar

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