Ali Mohamed Ali

جزاك الله كل خير أستاذ مجدى ورحم الله والديك

أحسنت أستاذ مجدى بارك الله فيك

بارك الله فيك هذه معادلة تاريخ نهاية الأجازة =IF(C2="","",(C2+D2)-1) وهى تعنى اذا كان لا يوجد تاريخ لبداية الأجازة فاجعل أيضا الخلية التي بها تاريخ نهاية الأجازة فارغ اى خالى من البيانات أيضا , وجزء المعادلة الأخرى اذا كان تاريخ بداية الأجازة موجود فلابد من زيادة عدد أيام الأجازة الى تاريخ البداية لكى احصل على تاريخ النهاية -ثم بعد ذلك أقوم بطرح 1 اما بالنسبة لمعادلة مباشرة العمل وهى =IF(C2="","",E2+1) وهى تعنى اذا كان لا يوجد تاريخ لبداية الأجازة فاجعل أيضا الخلية التي بها تاريخ مباشرة العمل فارغ اما الجزء الثانى اذا كان تاريخ بداية الأجازة موجود فيجب إضافة يوم واحد على تاريخ نهاية الأجازة لكى احصل على تاريخ مباشرة العمل وجزاك الله كل خير وتقبل الله منكم سائر الأعمال

اهلا بك فى المنتدى كان عليك من البداية رفع ملف وشرح المطلوب عليه-ولكنى قمت بعمل هذا الملف لك لعله المطلوب ملف للأجازة.xlsx

وذلك بعد استبدال كودك بهذا الكود Option Explicit '//////////////////////////////////////////////////////////////////// 'Password masked inputbox 'Allows you to hide characters entered in a VBA Inputbox. ' 'Code written by Daniel Klann 'March 2003 '//////////////////////////////////////////////////////////////////// 'API functions to be used Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook End Function 'Hope someone can use it! Sub TEST() Dim strAdminPWord As String strAdminPWord = InputBoxDK("Password required to proceed.", "Enter Licence Code") If strAdminPWord = "123" Then MsgBox "cool Password Correct ", vbOKOnly, "success" Else MsgBox ("You entered an invalid password") ' Exit Sub End If End Sub اخفاء باسورد تنفيذ الماكرو.xls

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

أحسنت استاذنا الكريم عمل رائع بارك الله فيك

وعليكم السلام اخى الكريم فقد تم عرض هذه المشاركة ومناقشتها من قبل على هذا الرابط https://www.officena.net/ib/topic/54296-حساب-مرتب-عنوان-معدل/ حساب الراتب الحالى للموظفين.xlsx

بارك الله فيك استاذ مجدى وزادك الله من فضله

تفضل لك ما طلبت تنسيق شرطى بشرط.xlsx

بارك الله فيك أستاذ سليم كود ممتاز جعله الله في ميزان حسناتك وبعد اذن حضرتك طبعا -ولإثراء الموضوع هذا حل أخر Masry.xlsm

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

السلام عليكم طالما انك لم تقم برفع ملف فيمكنك رؤية هذا الرابط ففيه ما تطلب https://www.officena.net/ib/topic/91345-سؤال-بخصوص-النسخ-واللصق-؟/

بارك الله فيك وجزاك الله كل خير

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

بارك الله فيك أستاذ أحمد ولكن اعتقد ان تكون المعادلة في الخلية bb7 هكذا =IF(AT7="Turkish Lira","Peaches",IF(AT7="USD DOLLARS","Cents"))

وعليكم السلام-تفضل ترحيل pdf.xlsm

بارك الله فيكم جميعا كلها حلول ممتازة

وعليكم السلام -بعد اذن الأستاذ مصطفى ولإثراء الموضوع 1ملف العملاء.xlsx

جزاكم الله جميعا كل خير

وعليكم السلام تفضل اخى الكريم عليك مشاهدة هذه الصورة لمعرفة سبب توقف المعادلة عن العمل Copy of Bank Statement _ 2019.xlsm

هذا هو الكود المستخدم فى حدث الصفحة وموجود بالفعل داخل الملف Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Target, Range("A2:A1000")) Is Nothing Then VBA.Calendar = vbCalGreg If Len(Target.Cells(1).Value2) <> 0 Then Cells(Target.Row, 2).Resize(Target.Rows.Count).Value = Date Cells(Target.Row, 3).Resize(Target.Rows.Count).Value = Now Else Cells(Target.Row, 2).Resize(Target.Rows.Count).Value = vbNullString Cells(Target.Row, 3).Resize(Target.Rows.Count).Value = vbNullString End If End If If Not Application.Intersect(Target, Range("H2:H1000")) Is Nothing Then VBA.Calendar = vbCalGreg If Len(Target.Cells(1).Value2) <> 0 Then Cells(Target.Row, 6).Resize(Target.Rows.Count).Value = Date Cells(Target.Row, 7).Resize(Target.Rows.Count).Value = Now Else Cells(Target.Row, 6).Resize(Target.Rows.Count).Value = vbNullString Cells(Target.Row, 7).Resize(Target.Rows.Count).Value = vbNullString End If End If End Sub

أظن أستاذ Cobone انك لم ترى الملف الأخير المرسل لك !!!!!!!

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

تفضل جدول سير قضايا.xlsm