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

السلام عليكم و رحمة الله غير لرقام بالمعادلة التى هى 1033 الى 1127 و تحل المشكلة ان شاء الله

أصدقائي واساتذتي الرائعون .. رسالة شكر وعرفان وتقدير أهديها لكم لوقوفكم بجانبي دوماً، فأنتم في القلب، و تتسابق الكلمات وتتزاحم العبارات لتنظم كلمات الشكر الذي لا يستحقه إلّا أنتم، إليكم يا من كان له قدم السبق في ركب العلم والتعليم، إليكم يا من بذلتم ولم تنتظرون العطاء. بارك الله فيكم وجعلها في ميزان حسناتكم

شكرا على هذه المعلومة اخوي موسى 🙂 انا لازلت على ابو كلتش ، من التنسيق اخلص شغلي ، متعود على طريقة العمل مال الاصدارات القديمة مال اكسس 🙂 جعفر

جرب هذا : 🙂

السلام عليكم و رحمة الله استخدم الكود التالى Sub TrAbsent() Dim ws As Worksheet, Sh As Worksheet Dim Shahr As String, x As Long, Rng As Range Set ws = Sheets("خلاصة نهائية"): Set Sh = Sheets("كشف") Shahr = Sh.Range("AD3").Text x = WorksheetFunction.Match(Shahr, ws.Range("D5:CY5"), 0) + 3 Sh.Range("AJ8:AR73").Copy ws.Cells(8, x).PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub

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

عقدنى انا كمان ونسانى وضع المرفق 😀

جرب المرفق بصراحة وضع النموذج بدون اطار و تكبيره عقدني وخصوصا ان جهازي بدون لوحة مفاتيح APE_2023_Stock.accdb

الف سلامه عليك اخى ومعلمى العزيز جعفر شفاك الله وعافاك ربنا ينعم عليك بالصحه والعافيه 💐 كان لديك خطا فى اسم الاستعلام لجرجس الصحيح G_RASED بدل من GRASED وطالما نموذج الباسورد مفتوح مخفى فاخدت القيمه مباشره منه If Forms!password!un = "مريم" Then Me.Code_snf.RowSource = "RASED" Else 'If Forms!password!un = "" Then Me.Code_snf.RowSource = "G_RASED" End If بالتوفيق

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

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

تفضل أخي date to-1.accdb

بعد إذن أخونا محمد يوسف قم بتجربة الكود في الملف التالي والذي سوف يقوم بالحفظ كملف PDF بشكل تلقائي لكل الأسماء الموجودة في القائمة المنسدلة الموجودة في الخلية D3 بيات توزيع المواد الغذائية 002.xlsm

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

السلام عليكم 🙂 اخي الفاضل @Ahmed_J مبروك علينا ترقيتك الى درجة خبير ، تستاهل 🙂 ولازلنا نبحث عن خبراء جدد 🙂 جعفر

وأحسن إليكم ونتمنى لكم التوفيق والشكر موصول للاستاذ بن علية لان هناك اقتباس في الكود من أحد حلوله

أو عدله - بعد اذن استاذنا ابو خليل - بنفس اسلوب استاذنا ابو خليل هكذا Me.DoctorID = Format(Str(i), "00") & "/" & Format(Str(x), "000")

في الوقت اللي الشباب اشتغلوا على الاجابة ، انا كنت مشغول في حذف الكود اللي ما له داعي !! انت عملت حقول وازرار في النماذج ، وبعدين حذفت حقول وازرار من النماذج ، وابقيت الكود !! اعدادت الاكسس عندي تمنعني من تشغيل البرنامج اذا فيه خطأ في مكان في الكود ، لذلك ، عينك ما تشوف الا النور ، طلع فيه بلاوي 😁 في كل صفحة كود ، جمعت لك جميع الاكواد اللي لا تنحذف في اسفل الصفحة ، وعملتها كملاحظة حتى لا تشتغل ، ويمكنك حذفها اذا اردث 🙂 جعفر 1554.APE_2023.accdb.zip ما لقيتها في جوجل ، فقلت اسالك عنها 🙂 وهاي اريد لها تفسير لوسمحت 🙂 جعفر

أنا أتيت بنصف الجواب .. أما موضوع المدة التجريبية فما اشتغلت فيه سابقا 😅🖐🏼️

وعليكم السلام ورحمة الله وبركاته 🙂 من مكتبتي .. هذه دالتان الأولى لتشفير البيانات والثانية لفك التشفير .. أخذتهما من أحد البرامج الخاصة بأستاذنا العزيز @ابو جودي أزال الله أتراحه وأدام الله أفراحه .. Option Compare Database Option Explicit 'ExxE=Encrypt 'DxxD=Decrypt ' دالة التشفير Function ExxE(ByVal JudyDecrypt As String) As String Dim iIndex As Integer Dim iEncoder As Integer Dim iEncodedVal As Integer Randomize ExxE = "" For iIndex = 1 To Len(JudyDecrypt) Do iEncoder = Int(98 * Rnd + 89) iEncodedVal = Asc(Mid(JudyDecrypt, iIndex, 1)) Xor iEncoder Loop While iEncodedVal = 1000 Or iEncodedVal < 99 ExxE = ExxE & Chr(iEncodedVal) & Chr(iEncoder) Next iIndex End Function ' دالة فك التشفير Function DxxD(ByVal JudyEncrypt As String) As String Dim iIndex As Integer Dim iDecodedVal As Integer DxxD = "" For iIndex = 1 To Len(JudyEncrypt) Step 2 iDecodedVal = Asc(Mid(JudyEncrypt, iIndex, 1)) Xor Asc(Mid(JudyEncrypt, iIndex + 1, 1)) DxxD = DxxD & Chr(iDecodedVal) Next iIndex End Function

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

السلام عليكم الحل فى Pivot Table لما تقف على الجدول هتلاقى حقل PF قى القائمة اسحبه فوق الاسم مع الصفوف هتلاقيه ظهر لكن ف سطر لوحده فوق الاسم وعلشان يظهر بجواره اختار إعدادات Pivot table ثم اختار المظهر Classic ها يظهرو ف نفس السطر ولكن فى سطر إجمالى تحته قم بأخفاءه بالضغط على الزر الايمن Hide الاجمالى والغاء علامة الصح بجواره

من مكتبتي .. أكواد لفتح الملفات الخارجية بدون رسائل تنبيه .. 🙂 (1) : Public Sub OpenFilePath(sFilePath As String) CreateObject("Shell.Application").Namespace(0).ParseName(sFilePath).InvokeVerb "Open" End Sub (2) : Public Sub OpenPath(strPath As String) Shell "explorer.exe" & " " & strPath, vbNormalFocus 'You can also Change it to : ' 'Shell "explorer.exe" & " " & strPath, vbHide 'Shell "explorer.exe" & " " & strPath, vbMaximizedFocus 'Shell "explorer.exe" & " " & strPath, vbMinimizedFocus 'Shell "explorer.exe" & " " & strPath, vbMinimizedNoFocus 'Shell "explorer.exe" & " " & strPath, vbNormalNoFocus End Sub (3) : Public Declare PtrSafe Function FileProtocolHandler Lib "url.dll" _ Alias "FileProtocolHandlerA" (ByVal hwnd As Long, ByVal hinst As Long, _ ByVal lpszCmdLine As String, ByVal nShowCmd As Long) As Long Public Sub OpenHyperlink(ByVal Url) FileProtocolHandler 0, 0, Url, 1 End Sub Sub test() OpenHyperlink ("D:\Testing") End Sub (4) : دالة ShellExecute لتشغيل البرامج أو الملفات الخارجية بدون رسائل مزعجة '=======================================(الدالة) Const SW_SHOW = 1 Const SW_SHOWMAXIMIZED = 3 Public Declare Ptrsafe 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 nShowCmd As Long) As Long '======================================= http://www.rdpslides.com/pptfaq/FAQ00479_ShellExecute_Example.htm '======================================= https://stackoverflow.com/questions/1374433/shellexecuteex-in-vba '======================================= 'SW_HIDE Hides the window. 'SW_MAXIMIZE Maximizes the window. 'SW_MINIMIZE Minimizes the window. 'SW_RESTORE Restores the window to normal (not maximized or minimized) size. 'SW_SHOW Activates the window and displays it at its current size. 'SW_SHOWDEFAULT Displays the window at a default size. 'SW_SHOWMAXIMIZED Displays the window maximized. 'SW_SHOWMINIMIZED Displays the window minimized. 'SW_SHOWMINNOACTIVE Displays the window minimized without giving it the focus. 'SW_SHOWNA Displays the window at its current size without giving it the focus. 'SW_SHOWNOACTIVATE Displays the window in its most recent size and position without giving it the focus. 'SW_NORMAL Displays the window at normal (not minimized or maximized) size. '============================================================(طرق الاستدعاء) Some particularly useful combinations include: Open a folder in a folder view: ShellExecute hWnd, "open", "C:\whatever", vbNullString, vbNullString, SW_SHOWNORMAL Explore a folder with Windows Explorer: ShellExecute hWnd, "explore", "C:\whatever", vbNullString, vbNullString, SW_SHOWNORMAL Launch the Find utility from a particular directory: ShellExecute hWnd, "find", "C:\whatever", vbNullString, vbNullString, SW_SHOWNORMAL Display a Web page in the system's default browser: ShellExecute hWnd, "open", "C:\whatever\test.html", vbNullString, vbNullString, SW_SHOWNORMAL (5) :دالة ShellWait لفتح الملفات الخارجية والإنتظار حتى تنتهي المهمة '-----------------------------------------------------------------------------------www.officena.net-----' ' __ __ _ ' ' / _|/ _| | | ' ' __ ____ ____ _____ | |_| |_(_) ___ ___ _ __ __ _ _ __ ___| |_ ' ' \ \ /\ / /\ \ /\ / /\ \ /\ / / _ \| _| _| |/ __/ _ \ '_ \ / _\`| | '_ \ / _ \ __| ' ' \ V V / \ V V / \ V V / (_) | | | | | | (_| __/ | | | (_| |_| | | | __/ |_ ' ' \_/\_/ \_/\_/ \_/\_(_)___/|_| |_| |_|\___\___|_| |_|\__,_(_)_| |_|\___|\__| ' ' Developed By Mohammed Essam ' '------www.officena.net----------------------------------------------------------------------------------' Option Compare Database Option Explicit '***************** Code Start ****************** 'This code was originally written by Terry Kreft. 'It is not to be altered or distributed, 'except as part of an application. 'You are free to use it in any application, 'provided the copyright notice is left unchanged. ' 'Code Courtesy of 'Terry Kreft Private Const STARTF_USESHOWWINDOW& = &H1 Private Const NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& Private Type STARTUPINFO cb As Long lpReserved As String lpDesktop As String lpTitle As String dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Long hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessID As Long dwThreadID As Long End Type #If VBA7 And Win64 Then Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal _ hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _ lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _ lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _ ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _ ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _ lpStartupInfo As STARTUPINFO, lpProcessInformation As _ PROCESS_INFORMATION) As Long Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _ hObject As Long) As Long #Else Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _ hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function CreateProcessA Lib "kernel32" (ByVal _ lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _ lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _ ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _ ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _ lpStartupInfo As STARTUPINFO, lpProcessInformation As _ PROCESS_INFORMATION) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal _ hObject As Long) As Long #End If Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long) Dim proc As PROCESS_INFORMATION Dim Start As STARTUPINFO Dim Ret As Long ' Initialize the STARTUPINFO structure: With Start .cb = Len(Start) If Not IsMissing(WindowStyle) Then .dwFlags = STARTF_USESHOWWINDOW .wShowWindow = WindowStyle End If End With ' Start the shelled application: Ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, _ NORMAL_PRIORITY_CLASS, 0&, 0&, Start, proc) ' Wait for the shelled application to finish: Ret& = WaitForSingleObject(proc.hProcess, INFINITE) Ret& = CloseHandle(proc.hProcess) End Sub '***************** Code End **************** وتناديها : ShellWait("C:\MyApp.exe", vbNormalFocus) أختر اللي يعجبك منها 😁

مبارك عليك الترقية أخي @Ahmed_J .. 🙂🌹 إضافة ثمينة للمنتدى وجوهرة تضاف لهذا العقد الجميل 🙂

وعليكم السلام 🙂 نعم ، اعمل كلمة مرور لبرنامج الواجهة 🙂 جعفر

مبارك أخي @Ahmed_J تستاهل كل خير واعانك الله

مبروك الترقية @Ahmed_J أدعو الله أن ييسر لك كل أمورك، وأن يكتب لك التوفيق في خدمة اخوانك في المنتدى

السلام عليكم 🙂 دائما البساطة تجذب الواحد ، والعين تعشق قبل القلب وتفاصيله 🙂 شكرا لك 🙂 جعفر

Welcome, and I hope you benefit from the topic, the password is 1234

الف مبروك اخي احمد ، وتستاهل اكثر

ماشاء الله تبارك الله ... تستاهل @Ahmed_J الف مبروك

الف مبروك لولدنا العزيز احمد ... مزيد من التألق والابداع

مبارك اخى الكريم

الف مبروك الترقية

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

نبارك لكم الترقية ونتمنى لكم التقدم والنجاح المستمرين .. وعساكم ع القوة.

الف مبروك اخى @Ahmed_J واعانك الله ع طلبات اخوانك

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

أهلا @محمد احمد لطفى الشفرة التالية تفي بالغرض إن شاء الله.. Private Sub أمر0_Click() On Error GoTo ERR_CODES Dim HTML_FILE_NAME As String Dim HTML_TITLE As String Dim TABLE_NAME As String Dim SQL As String '-- ASSIGNING VALUES TO SQL STATMENT VARIABLES Const HTML_SPECIFICATION As String = " [HTML IMPORT;HDR=YES;] " HTML_FILE_NAME = CurrentProject.Path & "\" & "0125.HTML" '.. THE HTML FILE IS THE DATABASE HTML_TITLE = "0125" '.. THE HTML TABLE NAME IS THE HTML TITLE CREATE_TABLE_SQL: '-- ASSIGNING TABLE NAME USING INPUTBOX TABLE_NAME = InputBox(Err.Description & " Plase Enter New Table Name.", _ "New Table Name", , Me.WindowWidth / 2, Me.WindowHeight / 2) If Len(TABLE_NAME) = 0 Then GoTo EXIT_SUB End If '-- CREATE SQL STATMENT SQL = "" SQL = SQL & " SELECT * INTO " & TABLE_NAME SQL = SQL & " FROM " & HTML_TITLE SQL = SQL & " IN'" & HTML_FILE_NAME & "'" SQL = SQL & HTML_SPECIFICATION '-- EXECUTE SQL STATEMENT TO CREATE TABLE CurrentDb.Execute SQL Application.RefreshDatabaseWindow EXIT_SUB: Exit Sub ERR_CODES: If Err.Number = 3010 Then GoTo CREATE_TABLE_SQL Else MsgBox Err.Number & vbNewLine & Err.Description End If End Sub IMPORT_HTML_TABLE.zip

فكرة رائعة وممتازة.. هل يوجد مثال تطبيقي مع جزيل الشكر وعظيم الامتنا،،

احسنت استاذ /وجيه جزاك الله خيراً وجعلة الله فى ميزان حسناتك

السلام عليم اخي جرب المرفق Test.xlsm

عليكم السلام ورحمة الله وبركاته تفضل أخي الكريم Sub test() With Sheets("يومية الحضور والإنصراف").Range("B4:C" & Sheets("يومية الحضور والإنصراف").Cells(Rows.Count, 1).End(xlUp).Row) .Formula = "=IFERROR(VLOOKUP($A:$A,Table9,COLUMN(),0),"""")" .Value = .Value End With With Sheets("رصيد الأجازات").Range("B3:D" & Sheets("رصيد الأجازات").Cells(Rows.Count, 2).End(xlUp).Row) .Formula = "=IFERROR(VLOOKUP($A:$A,Table9,COLUMN(),0),"""")" .Offset(, 3).Resize(, 1).Formula = "=IFERROR(IF(DATEDIF([@[تاريخ التعيين]],$D$1,""D"")/30>3.1,""يستحق"",""""),"""")" .Offset(, 5).Resize(, 1).Formula = "=IF([@[معادلة الرصيد]]=""يستحق"",$O$1+[@[معالجة الرصيد]],0)" .Offset(, 6).Resize(, 1).Formula = "=[@[الرصيد المرحل]]+[@[رصيد 2023]]" .Offset(, 7).Resize(, 1).Formula = "=(COUNTIFS('يومية الحضور والإنصراف'!$A:$A,$A3,'يومية الحضور والإنصراف'!$H:$H,""أجازة"")+(COUNTIFS('يومية الحضور والإنصراف'!$A:$A,$A3,'يومية الحضور والإنصراف'!$H:$H,""أجازة مجمعة"")))" .Offset(, 8).Resize(, 1).Formula = "=(COUNTIFS('يومية الحضور والإنصراف'!$A:$A,$A4,'يومية الحضور والإنصراف'!$H:$H,""أجازة عارضة""))" .Offset(, 9).Resize(, 1).Formula = "=IF(E3=""يستحق"",$N$1-[@[ عارضة]],0)" .Offset(, 10).Resize(, 1).Formula = "=(([@[إجمالي الرصيد المستحق]]-([@[ سنوي]]+[@[ عارضة]]+[@[تسوية نقدي]])))-[@[باقي رصيد العارضة]]" .Offset(, 11).Resize(, 1).Formula = "=([@[باقي رصيد السنوي ]]+[@[باقي رصيد العارضة]])" With .Resize(, 12) .Value = .Value End With End With End Sub

احسنت استاذ /وجيه جزاك الله خيراً

جعله الله فى ميزان حسناتك

رووووووعة بارك الله فيكم اخي الكريم

بارك الله بيك

السلام عليكم ما شاء الله جميل جدا وشكرا لك

اتفضل استاذ اليك هذا Public Sub OpenDocument(DocPath As String) Dim A As Long A = Shell("RUNDLL32.EXE URL.DLL,FileProtocolHandler " & DocPath, vbMaximizedFocus) End Sub Private Sub Command1_Click() Call OpenDocument("C:\Users\Shivan\Desktop\TEST.pdf") End Sub

السلام عليكم أخي العزيز بالملف المرفق ، أظهرت لك الأعمدة المخفية ولخصت الحل في 6 خطوات تم شرحها تفضل الملف بيانات النقص والزيادة3.rar