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

أخي الكريم أرفق ملف و وضح الطلب قدر الإمكان =NOW()+0.25 بالنسبة للمعادلة فهي تُستخدم لإضافة ربع يوم (6 ساعات) إلى التاريخ والوقت الحاليين

رائع

و عليكم السلام ورحمة الله وبركاته الملف مطبق عليه الفلترة باستخدام slicer الفلترة2.xlsx

وعليكم السلام ورحمة الله تعالى وبركاته يمكنك تعديل هدا بما يناسبك Option Explicit Sub Sauvegarde_WB() Dim WS As Worksheet, CrWS As Workbook, newWs As Worksheet, f As Worksheet Dim chemin$, sNom$, dossier$, sPath$, n As Boolean On Error GoTo EndClear SetApp False Set CrWS = Workbooks.Add(xlWBATWorksheet) Set f = CrWS.Sheets(1): f.Name = "Temp" n = True For Each WS In ThisWorkbook.Worksheets WS.Copy After:=CrWS.Sheets(CrWS.Sheets.Count) Set newWs = CrWS.Sheets(CrWS.Sheets.Count) newWs.UsedRange.Value = newWs.UsedRange.Value On Error Resume Next: newWs.Buttons(1).Delete: On Error GoTo 0 newWs.Name = Left(WS.Name, 31) If n Then: f.Delete: n = False Next WS dossier = ThisWorkbook.Path & "\Workbook_Copy" If Dir(dossier, vbDirectory) = "" Then MkDir dossier sPath = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) sNom = sPath & "_" & Format(Now, "dd-mm-yyyy") & ".xlsx" chemin = dossier & "\" & sNom CrWS.SaveAs Filename:=chemin, FileFormat:=xlOpenXMLWorkbook CrWS.Close False SetApp True Exit Sub EndClear: SetApp True End Sub Private Sub SetApp(ByVal enable As Boolean) With Application .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End With End Sub TEST.xlsb

وإياكم مثلما دعيتم وأكثر في هذا اليوم الطيب .. العفو يا صديقي ..

وعليكم السلام ورحمة الله تعالى وبركاته بعد معاينة آخر مشاركاتك على المنتدى إليك الكود ليتوافق مع جميع الإصدارات سواءا 32bit أو 64bit جرب هدا ربما يناسبك Option Explicit #If VBA7 Then Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long #Else Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long #End If Private Const Style As Long = -16 Private Const Menu As Long = &H80000 Private Const MIN As Long = &H20000 Private Const MAX As Long = &H10000 Private Sub UserForm_Activate() Dim xForm As LongPtr, tmps As Long xForm = FindWindow("ThunderDFrame", Me.Caption) If xForm <> 0 Then tmps = GetWindowLong(xForm, Style) tmps = tmps Or Menu Or MIN Or MAX SetWindowLong xForm, Style, tmps DrawMenuBar xForm End If End Sub TEST Minimize.xlsb

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Option Explicit Public Property Get WS() As Worksheet: Set WS = Sheets("الاختلافات"): End Property Sub Button1_Click() Dim i As Long SetApp False For i = 3 To 62 WS.Rows(i).Hidden = (Application.WorksheetFunction.CountA(WS.Range("B" & i & ":R" & i)) = 0) Next i SetApp True End Sub Sub Button49_Click(): SetApp False: WS.Rows("3:62").Hidden = False: SetApp True: End Sub Private Sub SetApp(ByVal enable As Boolean) On Error Resume Next With Application .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End With On Error GoTo 0 End Sub كود إخفاء وإظهار.xlsb

لم يقبل التحويل لذا فتحت قاعدة 2003 وجلبت اليها جميع الكائنات الموجودة لا اعلم ان كانت ستعمل معك على الوجه الأكمل وعذرا على التأخر في تحقيق طلبك db2003.rar

الصف الأول / النصف الأول : يوجد 21 طالبا حاصلون على الدرجة الكبرى 400 كيف تتعامل معهم ؟ كلهم الاول مكرر .. هذا هو العدل يوجد 11 طالب خارج الحسبة اذا اخترت حسب شروطك .. فلذي اسمه يااسر او ياسين او يارا ... الخ نحاسب اهاليهم ليه اختاروا لهم هذه الأسماء حتى تواريخ الميلاد نقص ايام او شهر ، هل تعطي افضلية ؟

صدقت تماماً .. لم لا نحصل على عدد ايام الحضور بطريقة تعتمد على الجدول المؤقت بدلاً من الاستعلامات !!!!! فكرة بسيطة