مساهدية نجيب

vbn Function IRG2022_New(moTr) Dim abat As Double moTr = (Int(moTr / 10)) * 10 If moTr <= 30000 Then IRG2022_New = 0 Else Select Case moTr Case 20000 To 40000: IRG2022_New = (moTr - 20000) * 0.23 Case 40001 To 80000: IRG2022_New = 4600 + (moTr - 40000) * 0.27 Case 80001 To 160000: IRG2022_New = 15400 + (moTr - 80000) * 0.3 Case 160001 To 320000: IRG2022_New = 39400 + (moTr - 160000) * 0.33 Case Is > 320000: IRG2022_New = 92200 + (moTr - 320000) * 0.35 End Select abat = IRG2022_New * 0.4 If abat < 1000 Then abat = 1000 If abat > 1500 Then abat = 1500 IRG2022_New = Round(IRG2022_New - abat, 1) '1= Normal 2= Handicape ' If m = 0 Then If moTr <= 35000 Then IRG2022_New = Round(IRG2022_New * (137 / 51) - (27925 / 8), 1) ' End If ' If m = 1 Then ElseIf moTr < 35001 Then IRG2022_New = Round(IRG2022_New * (93 / 61) - (81213 / 41), 1) ' End If End If End If End Function

تم الارسال شكرا مسبقا

ارجو ارسال الايمايل ان امكن ذلك . الملف به معلومات موظفين لا اريد الا التحويل الى صيغة للعمل عليها و اعادتها الى نفس الملف شكرا صديقي

ملف كبير هل ارسلت لي الايمايل لارسله لك اخي الكريم . انا اريد اي تطبيق يقوم بتحويله الى اي صيغة يمكنني التعامل بها

ابحث عن محول اوي شيء متعلق ب التحويل من صيغة gsd الى اي صيغة مثل الاكسال converter *.gsd ارجو المساعدة ان امكنكم هذا

=IF(SUM(D4-C4)>0;SUM(D4-C4);"")

اليك الملفات مفتوحة شكرا finance-equations-calculates-ratios-irr-npv-unprotected.xls investment_valuation-unprotected.xls

شكرا وجدت الحل Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("g7")) Is Nothing Then Call langue_FR Else Call langue_arab End If End Sub

ارجو المساعدة في طريقة تحديد الكتابة في خلية محددة سواء انجيزي او عربي Private Sub Worksheet_SelectionChange(ByVal Target As Range) '''''''''If Sheet2.Range("g7").Select Then حدد الخلية ("g7") ChaingeLanguage "English" Else ChaingeLanguage "Arabic" End If End Sub

ارجو ان ان يكون هذا المطلوب قم بانشاء ملف في c:\nadjib و افتح الملف المرفق و قم بتمكين وحدات الماكرو و المكتوبة nadjib11 سيقوم بانشاء ملفات و كل ملف باسم الشخص المراد كما في المثال و كل شخص بملفه الخاص RD4.xlsm

شكرا اخي الملف فعلا .xlsm

اواجه مشكلة في تمكين وحدات الماكرو مع اني عملت بالملف و اعرف كيفية التمكين و لكن الرسالة تبين كل شيء اي الصورة

السلام عليكم و رحمة الله كل عام و انتم بالف خير هل يمكن ربط ملف اكسال به معادلات او طلب معلومات من ملف به كل المعلومات dbf اي ان كل المعلومات عن الموظفين نجدها في dbf حيث نطلب مجموعة معينة من المعلومات و يتم غلف dbf بكلمة سر كي لا يمكن الاطلاع على معلومات الموظفين

للخبراء اريد ادراج كود في شيت يمكن وحدات الماكرو اوتوماتيكي و لا يفتح الملف الا بتمكين الماكرو و اضافة كود حذف للملف بعد 2 دقيقتان كود لتمكين وحدات المكرو اوتوماتيكي Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) kh_wVisible False ThisWorkbook.Close Not CBool(ThisWorkbook.Saved) End Sub Private Sub Workbook_Open() kh_AhlnWShln End Sub كود لح>ف الملف Option Explicit Private Const MAX_USES As Long = 1 Private Sub Workbook_Open() Dim lNumberOfUses As Long On Error Resume Next lNumberOfUses = Evaluate("NumberOfUses") If Err.Number = 13 Then Me.Names.Add "NumberOfUses", 1, False Me.Save Exit Sub End If Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False Me.Save If Evaluate("NumberOfUses") > MAX_USES Then Kill_Myself End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub حاورت الدمج بينهما و لم اتمكن من ذلك ممكن الحل من الخبراء ان امكن مهما كان الملف و لو شيت فارغة لا تفتح الا بالكود مع ح>فها بعد دقيقتان شكرا للجميع

كود لتمكين وحدات المكرو اوتوماتيكي Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) kh_wVisible False ThisWorkbook.Close Not CBool(ThisWorkbook.Saved) End Sub Private Sub Workbook_Open() kh_AhlnWShln End Sub كود لح>ف الملف Option Explicit Private Const MAX_USES As Long = 1 Private Sub Workbook_Open() Dim lNumberOfUses As Long On Error Resume Next lNumberOfUses = Evaluate("NumberOfUses") If Err.Number = 13 Then Me.Names.Add "NumberOfUses", 1, False Me.Save Exit Sub End If Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False Me.Save If Evaluate("NumberOfUses") > MAX_USES Then Kill_Myself End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub حاورت الدمج بينهما و لم اتمكن من ذلك ممكن الحل من الخبراء ان امكن مهما كان الملف و لو شيت فارغة لا تفتح الا بالكود مع ح>فها بعد دقيقتان شكرا للجميع

كود لتمكين وحدات المكرو اوتوماتيكي Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) kh_wVisible False ThisWorkbook.Close Not CBool(ThisWorkbook.Saved) End Sub Private Sub Workbook_Open() kh_AhlnWShln End Sub كود لح>ف الملف Option Explicit Private Const MAX_USES As Long = 1 Private Sub Workbook_Open() Dim lNumberOfUses As Long On Error Resume Next lNumberOfUses = Evaluate("NumberOfUses") If Err.Number = 13 Then Me.Names.Add "NumberOfUses", 1, False Me.Save Exit Sub End If Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False Me.Save If Evaluate("NumberOfUses") > MAX_USES Then Kill_Myself End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub حاورت الدمج بينهما و لم اتمكن من ذلك ممكن الحل من الخبراء ان امكن مهما كان الملف و لو شيت فارغة لا تفتح الا بالكود مع ح>فها بعد دقيقتان شكرا للجميع

شكرا اخي الكريم . يوجد حل آخر و هو عمل الفورب في موقع انترنات مثلا ادراج قسم به جميع المواد و كل مادة بها رقم سري ليتيح للمعلم الدخول الى مادته فقط و لا يستطيع احد آخر الدخول الى مادته او التغيير بها و يستعمل ملف تجميع او تحويل البيانات من الموقع الى جهاز المدير و هذا كله php لاكن احاول التعامل بها و لا كنها صعبة مع نقصي في اللخة و الدوال او c++ او الجافا . ممكن الخبراء يتيحو المجال لهذا الاقتراح فهو يشمل جميع الاعمال

شكرا اخي الكريم . هل يمكن اضافت صلاحيات للملف

كود لتمكين وحدات المكرو اوتوماتيكي Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) kh_wVisible False ThisWorkbook.Close Not CBool(ThisWorkbook.Saved) End Sub Private Sub Workbook_Open() kh_AhlnWShln End Sub كود لح>ف الملف Option Explicit Private Const MAX_USES As Long = 1 Private Sub Workbook_Open() Dim lNumberOfUses As Long On Error Resume Next lNumberOfUses = Evaluate("NumberOfUses") If Err.Number = 13 Then Me.Names.Add "NumberOfUses", 1, False Me.Save Exit Sub End If Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False Me.Save If Evaluate("NumberOfUses") > MAX_USES Then Kill_Myself End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub حاورت الدمج بينهما و لم اتمكن من ذلك ممكن الحل من الخبراء ان امكن مهما كان الملف و لو شيت فارغة لا تفتح الا بالكود مع ح>فها بعد دقيقتان شكرا للجميع

لم تنجح العملية و لم يقم الملف بفتح اليوزرفورم . من لديه الحل و للعلم جربت اوفيس 2007

اعمل على ملف اكسال به العديد من الاوراق و قمت بتحميله على OneDrive سكاي درايف و يعمل مع الجميع بطريقة جيدة و المشكل الوحيد اني اريد عمل صلاحيات لكل موظف اي الدخول بكود و اسم معين و الطريقة نجحت في الاكسال حيث انه لا يمكنه ان يرى الا ورته و لم تنجح في OneDrive مع العلم اني اعمل على اوفيس 2003 ممكن انه قديم سوف اقوم بتحميله على 2007 و أرى النتيجة و ان صلحت فهذا امر رائع بالنسبتي لي لاني لا اريد ان يرى احد شيء الا المدير اي انا و لا يمكنه الاطلاع على المعلومات الاخرى ممكن ان تجربو و لاهل الخبرة ما هو الحل لعمل الاكواد في OneDrive

Option Explicit Private Const MSG_TITLE As String = "Deleting Current Workbook ..." Private Const MSG_TEXT As String = _ "You are about to permanently delete the current workbook located in :" Sub Kill_Myself() Dim lUserDecision As Long Dim sMsg As String On Error Resume Next sMsg = "Attention !" & vbNewLine & vbNewLine sMsg = sMsg & MSG_TEXT & vbNewLine sMsg = sMsg & "'" & ThisWorkbook.FullName & "'" & vbNewLine sMsg = sMsg & "from Disk!!" & vbNewLine & vbNewLine sMsg = sMsg & "Go ahead ?" & vbNewLine & vbNewLine Beep lUserDecision = _ MsgBox(sMsg, vbExclamation + vbYesNo, MSG_TITLE) With ThisWorkbook If lUserDecision = vbYes Then .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End If End With End Sub الحذف بعد شهر Option Explicit Private Sub Workbook_Open() Dim lInitialDate As Long On Error Resume Next lInitialDate = Evaluate("InitialDate") If Err.Number = 13 Then Me.Names.Add "InitialDate", Date, False Me.Save End If If Date > Evaluate("InitialDate") + 30 Then Kill_Myself End Sub Private Sub Kill_Myself() .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End Sub بعد 3 مرات Option Explicit Private Const MAX_USES As Long = 3 Private Sub Workbook_Open() Dim lNumberOfUses As Long On Error Resume Next lNumberOfUses = Evaluate("NumberOfUses") If Err.Number = 13 Then Me.Names.Add "NumberOfUses", 1, False Me.Save Exit Sub End If Me.Names.Add "NumberOfUses", Evaluate("NumberOfUses") + 1, False Me.Save If Evaluate("NumberOfUses") > MAX_USES Then Kill_Myself End Sub Private Sub Kill_Myself() With Me .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With End Sub