نبيل عبد الهادي

اليك الملف المرفق وفي ورقة سلم الرواتب وعلى فرض ان : 1- جدول رقم 1 يمثل بيانات الرواتب للموظفين 2-جدول رقم 2 يمثل خلاصة المطلوب للدرجات والمراحل (عدد شاغليها ومجموع رواتبهم ) 22.xlsx

اذا كنت تقصد اخفاء قيمة الصفر اخفاء Hidezero اظهار showzero أظهار البنود (1).xls

تفضل ترقيم تلقائى متسلسل.xlsm

تفضل نقر مزدزج على اي خلية في ورقة "حساب العملاء" يعطيك النتائج في الاعمدة (K' J' I' H) officena 2.xlsm

1- انتقل إلى: ملف > خيارات > خيارات متقدمة. 2- ضمن "قص ونسخ ولصق" تأكد من وجود علامة الصح على ثلاث خيارات الموجوده اسفله In English File > Options > Advanced Options > Cut, Copy and Paste

p حاضر -------------> Present off موقوف -----------> off H عطلة ---------------> holiday HW عطلة يسمح فيها العمل ------------ holiday work A غائب -----------------> absent SL اجازة مرضية -------------------> Sick leave CL اجازة عادية ------------------> Casual leave EL اجازة مكتسبة --------------> Earned leave LWP اجازة بدون اجر -----------> Leave without pay SP اجازة خاصة -----------------> Special leave

كما في الكود الذي ارفقه الاستاذ علي .... واتبع مايلي: 1- ضع هذا الكود في module Option Explicit 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 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 RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 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 2- ضع هذا الكود في حدث الورقة sheet1 بدل الكود الذي ارفقته "Password:"123123 Private Sub CommandButton1_Click() Dim strAdminPWord As String strAdminPWord = InputBoxDK("Password required to proceed.", "Enter Licence Code") If strAdminPWord = "123123" Then MsgBox "كلمة المرور صحيحة ", vbOKOnly, "success" Else MsgBox ("كلمة المرور خاطئة حاول مرة اخرى") ' Exit Sub End If End Sub

تفضل ورقة الإستهلاك اليومي عامة 2013.xlsm

تم عمل نطاق طباعة ديناميكي للصفوف والاعمدة يتغير تلقائيا مع اضافة اي بيانات جديد ... جرب اضافة اي بيانات جديده خارج حدود الطباعة ولاحظ طبع الورقة تلقائيا (1).xlsm

الارقام مخزنة كنص وليس كرقم لذلك يحدث الخطأ اختر الخلية ثم من مربع الاخطاء اختر تغير كرقم Book2.xlsx

Option Explicit Sub Dive_Last_Row() If ActiveSheet.Name = "الايراد" Then Exit Sub Sheets("الايراد").Range("a3").End(4).Offset(1).Resize(, 3).Value = _ ActiveSheet.Range("a4").End(4).Resize(, 3).Value MsgBox "تم الترحيل", vbDefaultButton1, "رسالة تنبيه " End Sub

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

اذا كنت تقصد اخفاء الاعمدة التي مجموعها = (0) استخدم الكود التالي Sub print1() Application.ScreenUpdating = False 'اخفاء الاعمدة في الصف (39) ضمن المدى المحدد والتي مجموعها صفر Sheets("copy").Select Dim CL As Range For Each CL In [C39:AS39] If CL = 0 Then CL.EntireColumn.Hidden = True Next CL '---------------------------------------- 'طباعة ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False '----------------------------------------- 'اظهار الاعمدة المخفية بعد الطباعة Columns("A:AT").Select Selection.EntireColumn.Hidden = False Range("C2").Select Application.ScreenUpdating = False End Sub

تفضل 1- تم اضافة الاعمدة (L ; K ;J) في ورقة السجل ليتلائم مع طلبك 2- تم اضافة تنسيق شرطي كل موظف يحقق شرط "يستحق تغير الدرجة" وقد مضى عليه 5 سنوات يتم تلوين الصف بالكامل تغيير درجة وظيفية مع تاريخ اخر تغيير - 1.xlsx

تفضل يمكن لك تغير رقم العمود في الكود الموجود في حدث الورقة 1 كذلك يمكن لك الاستفادة من الكود في حدث الورقة 2 Hany.xlsm

ضع السطر التالي في بداية الكود ليتم الغاء حماية الورقة ActiveSheet.Unprotect Password:="123" وضع السطر التالي في نهاية الكود ليتم تفعيل حماية الورقة ActiveSheet.Protect Password:="123" يمكن لك تغير الباسوورد مابين علامتي الاقتباس " "

1- عن طريق عمل اختصار للملف الاصلي على سطح المكتب اي تعديل سوف يعدل في النسخه الاصلية 2-عن طريق الاكواد الكود الاول لعمل نسخه واحده باسم الملف في المجلد المفترض من البارتش المفترض (يمكن تغيره) Sub backup() Application.DisplayAlerts = False ActiveWorkbook.SaveCopyAs Filename:="D:\backup\" & _ ActiveWorkbook.Name ActiveWorkbook.Save Application.DisplayAlerts = True Call MsgBox(" تم الحفظ بنجاح ", mBox, "شكرا لكم") End Sub الكود الثاني لعمل نسخه باسم الملف عند الحفظ كل مره في الساعه والدقيقه والثانية في المجلد الفترض من البارتشن المفترض (يمكن تغيره) Sub myBackup() Dim strDate As String, strTime As String strDate = Format(Date, "DD-MM-YYYY") strTime = Format(Time, "hh.mm.ss") Application.DisplayAlerts = False With ActiveWorkbook .SaveCopyAs Filename:="D:\backup\" & strDate & "_" & strTime & "_" & .Name End With Application.DisplayAlerts = True Call MsgBox(" تم الحفظ بنجاح ", mBox, "شكرا لكم") End Sub

$G2 : تثبيت للعمود فقط. G$6 : تثبيت للسطر فقط. $G$6 : تثبيت للعمود و السطر والزر F4 في الكيبورد يتحكم في كل ذلك من خلال عدد النقرات عليه بمعنى حذف او اضافة علامة الدولار

تفضل اخي عله المطلوب جدول غياب الموظفين1 (1).xlsx

هناك عدة طرق ومنها والشرح هنا حسب الصورة التي ارفقتها 1- مايخص الصفوف اعلى الجدول اختيار الصفوف بالوقوف على رقم الصف ثم لون التعبئة اختر اللون الرمادي وحسب التدرج ومن نفس التعبئة نختار اللون الخاص بالعناوين 2- مايخص الاعمدة يسار الجول نختار العمود بعد نهاية الجدول ثم Ctrl + Shift مع أحد مفاتيح الأسهم وفي المثال هنا نختار السهم الى اليسار لننتقل الى اخر عمود في الورقة ثم كذلك لون التعبة الرمادي حسب التدرج

يفضل ارفاق ملف ليتم تلبية طلبك بالشكل الصحيح

ضع المعادلة التالية في H3 واسحب للاسفل =IF(AND(D3<>"";D3<>0);TODAY();"")

استخدم الفاصلة المنقوطة ( ; ) بدلا من العادية ( , ) ستعمل المعادلة بشكل صحيح

,كذلك ولاثراء الموضوع في حالة الطرح غير هذا السطر Range("a2:a10").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd بهذا السطر Range("a2:a10").PasteSpecial Paste:=xlPasteValues, Operation:=xlSubtract

ضع الكود التالي في حدث الورقة سوف يعمل احتواء تلقائي للصفوف والاعمدة .. او ارفع ملف للعمل عليه Private Sub Worksheet_Change(ByVal Target As Range) Cells.Select Selection.Rows.AutoFit Selection.Columns.AutoFit Range("A1").Select End Sub