الـعيدروس

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

السلام عليكم الاساتذه الاجلاء اسعد صباحكم الرجاء دمج الاضافات على هذا الكود Private Sub ComboBox1_Change() Application.ScreenUpdating = False [a3: ax2000].ClearContents ورقة1.[a3:az3].AutoFilter ورقة1.[a3:az3].AutoFilter Field:=6, Criteria1:=ComboBox1 ورقة1.Range("A4:Az2000").SpecialCells(xlCellTypeVisible).Copy Range("a3").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False ورقة1.[a3:az3].AutoFilter x = Range("b15000").End(xlUp).Row + 1 Cells(x, "b") = "المجمـــــوع" Cells(x, "c") = Application.WorksheetFunction.SUM(Range([c3], Cells(x, "c"))) Cells(x, "an") = Application.WorksheetFunction.SUM(Range([an3], Cells(x, "an"))) Cells(x, "ao") = Application.WorksheetFunction.SUM(Range([ao3], Cells(x, "ao"))) Cells(x, "aq") = Application.WorksheetFunction.SUM(Range([aq3], Cells(x, "aq"))) Cells(x, "aw") = Application.WorksheetFunction.SUM(Range([aw3], Cells(x, "aw"))) [d1].Select '============================== 'الاستاذ القدير الحسامي الرجاء دمج الاضافات التاليه في الكود '============================== .Font.Size = 16 '======= .Font.Bold = True '======= .Font.ColorIndex = 5 '======= .Borders.Weight = xlMedium '======= .Borders.ColorIndex = 3 '======= .Interior.ColorIndex = 36 '======= .Columns.AutoFit '======= .HorizontalAlignment = xlCenter '======= .VerticalAlignment = xlCenter '======= .RowHeight = 25 '======= '============================== End Sub

السلام عليكم كود لنسخ من الاكسل وفتح ملف ورد جديد ولصقها فيه على حسب المدى الي تحدده انت في الكود اليكم الكود Sub proWord() Dim varDoc As Object Set varDoc = CreateObject("Word.Application") varDoc.Visible = True Sheets("ورقة1").Range("A1:f20").Copy varDoc.documents.Add varDoc.Selection.Paste varDoc.activedocument.SaveAs ThisWorkbook.Path & "/" & "testWord.doc" Application.CutCopyMode = False End Sub

السلام عليكم جزاك الله خير اخي يحيى على الكود الرائع

السلام عليكم الاخ الفاضل خير الايمان مشكور على دعائك وبالنسبه لمحرر الاكواد مالدي برنامج يقوم بهذا الغرض اليك المرفق هذا رابط البرنامج http://www.4shared.com/file/M64O2_N0/setup_2.html وهذا رابط السيريال http://www.4shared.com/document/PU8T2mPe/sERAL.html

السلام عليكم الاخ yahiaoui مامهمته هذا المفتاح هل يقوم بخفض الماكرو بشكل مستمر ام ماذا ارجو الشرح

السلام عليكم الاخ yahiaoui مشكور على مرورك العطر

السلام عليكم الاستاذ الفاضل ولد المجرب مشكور وجزاك الله خيرا اخوك المخلص أبو نصار

السلام عليكم الاخ cat101 بالنسبه لمحرر الاكواد له برنامج اخر الاستاذ الفاضل ولد المجرب جرب هذا Sub PasswordBreaker() Dim i As Integer, j As Integer, k As Integer Dim l As Integer, m As Integer, n As Integer Dim i1 As Integer, i2 As Integer, i3 As Integer Dim i4 As Integer, i5 As Integer, i6 As Integer On Error Resume Next For i = 65 To 66 For j = 65 To 66 For k = 65 To 66 For l = 65 To 66 For m = 65 To 66 For i1 = 65 To 66 For i2 = 65 To 66 For i3 = 65 To 66 For i4 = 65 To 66 For i5 = 65 To 66 For i6 = 65 To 66 For n = 32 To 126 ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) _ & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) ' ^---^ ^--^ /<<< ' / /---/ --'------------------------------/ '--------------^-----------------------------/ ' ' \<<< ' * ' ' ' ' ' ' ' ' Application.StatusBar = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If ActiveSheet.ProtectContents = False Then MsgBox "One useable password is " & Chr(i) & Chr(j) _ & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) _ & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Application.StatusBar = False Exit Sub End If Next n Next i6 Next i5 Next i4 Next i3 Next i2 Next i1 Next m Next l Next k Next j Next i Application.StatusBar = False End Sub

السلام عليكم كود لكسر شفرة ورقة محميه احمي الورقة بباسورد وشغل الماكرو وانتظر ولاحظ النتيجه اليكم الكود منقول من موقع اجنبي Sub PasswordBreaker() Dim i As Integer, j As Integer, k As Integer Dim l As Integer, m As Integer, n As Integer Dim i1 As Integer, i2 As Integer, i3 As Integer Dim i4 As Integer, i5 As Integer, i6 As Integer On Error Resume Next For i = 65 To 66 For j = 65 To 66 For k = 65 To 66 For l = 65 To 66 For m = 65 To 66 For i1 = 65 To 66 For i2 = 65 To 66 For i3 = 65 To 66 For i4 = 65 To 66 For i5 = 65 To 66 For i6 = 65 To 66 For n = 32 To 126 ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) _ ' ^---^ ^--^ /<<< ' / /---/ --'------------------------------/ '--------------^-----------------------------/ ' ' \<<< ' * ' ' ' ' ' ' ' ' & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Application.StatusBar = Chr(i) & Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If ActiveSheet.ProtectContents = False Then MsgBox "One useable password is " & Chr(i) & Chr(j) _ & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) _ & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Application.StatusBar = False Exit Sub End If Next n Next i6 Next i5 Next i4 Next i3 Next i2 Next i1 Next m Next l Next k Next j Next i Application.StatusBar = False End Sub

للرفع

السلام عليكم الاستاذ القديرالحسامي ارجو تعديل الكود يضيف لخلايا المجموع اطار شكلي مبروز بالاسود او تنسيق تسطير ثنائي ليكون واضح وارجو قراءه مشاركتي التي قبل هذه للجمع التراكمي منتظر ردك والسلام عليكم

السلام عليكم الاستاذ هانكوك وهذا برضه حل مشكور الله يحفظك وفي ميزان حسناتك انشاء الله واذا عندك فكره ااحلى للجمع التراكمي تكون كذا جمل الله حالك اشكرك دمت في حفظ الله ورعايته والسلام عليكم

السلام عليكم الاستاذ القدير الحسامي كنت منتظر ردك عبقري الله يجزيك الجنه قول امين كفيت ووفيت واذا تضيف في عمود المسلسل مجموع التسلسل يعني دالة count وجمع تراكمي كل ماتختار تصنيف يجمع ويلصقها فلتكن في الخلايا c1,an1,ao1,aq1,aw1 واذا اخترت تصنيف اخر يقوم بعمل جمع تراكمي في كلن من الاعمدة 1 c1,an1,ao1,aq1,aw المراد كل مااختار تصنيف يعمل جمع تراكمي بحيث عند الاكتمال من كل التصنيفات يظهر جمع الكل في كلن c1,an1,ao1,aq1,aw1 او تضيف في التكست بوكس تحديد الكل بمعنى جلب كل التصنيفات اللي تشوفه اسهل وفي النهاية اتمنى لك كل التوفيق تلميذك المحب أبو نصار

السلام عليكم الاستاذ ولد المجرب مشكور يااخي رفعته على 4share http://www.4shared.com/file/KWMb3e_e/test.html

للرفع للاهميه

السلام عليكم الاستاذ الفاضل ولد المجرب ابداع ملحوظ الله يوفقك دمت في حفظ الله ورعايته تلميذكم المحب أبو نصار والسلام عليكم

السلام عليكم الاخت الفاضله اضفت زر طباعة الاوراق في ورقة ناجح انشاء الله يكون هو المطلوب http://www.2shared.com/document/yTKVy14v/__online.html

السلام عليكم مشكور استاذنا الفاضل كيماس على الاضافات واضفت كمان بدل التكست بوكس على حسب جدوله لاحظت العمود Transaction Type قائمة منسدله فيها خيارين فااضفت كومبكس وفيها الخيارين انشاء الله يكون افى بالغرض اليك المرفق بالنسبة للرفع للموقع مغلق عندي فرفعت الملف في موقع رفع اخر http://www.2shared.com/document/nm8Bw7t1/Monthly-kemas-abood.html

السلام عليكم ورحمة الله وبركاته احلى وارق تحيه مسائيه لجميع اساتذه وعباقرة الصرح الكبير عندي ملف وفيه ورقة3 لجلب تصنيفات ارجو التعديل عليه موضح الطلب على المرفق شاكر تعاونكم تلميذكم المحب أبو نصار اليكم المرفق http://www.2shared.com/file/LktDkrus/test.html

السلام عليكم وهالكود لحصر طباعة ورقة لأسم معرف فقط غيره مقيد على المستخدم اليكم الكود Private Sub Workbook_BeforePrint(Cancel As Boolean) Sheets("ورقة1").PageSetup.PrintArea = ورقة1.Range("PrintArea").Address End Sub

السلام عليكم وهذا كود تحديد مده زمنيه على حسب التاريخ وبعدها تتلغي الطباعه من الملف يصبح اختصار ctrl +f2 غير مفعل اليكم الكود Private Sub Workbook_BeforePrint(Cancel As Boolean) If Date >= VBA.DateSerial(2011, 5, 22) Then Cancel = True End If End Sub

السلام عليكم الاستاذ كيماس اضفت بعض التعديلات للكود ينفع لمن يطبع لورقة تقارير وليست قاعدة بيانات بعد الطباعه يقوم بحذف مدى انت تحدده في الكود اليكم الكود انشاء الله تستفيدو من الاضافه Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.CodeName = "ورقة3" Then Application.EnableEvents = False Cancel = True With ActiveSheet.PageSetup .RightHeader = Sheets(3).Range("c1").Value .CenterHeader = Sheets(3).Range("am1").Value .LeftHeader = Sheets(3).Range("Ao1").Value .RightFooter = Sheets(3).Range("Av1").Value & Date With ورقة3 ورقة3.PrintOut Union(.[A3:az300], [a5]).ClearContents End With End With Application.EnableEvents = True End If 1 End Sub

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

السلام عليكم ورحمة الله وبركاته استاذ وعبقري ورمز ساطع من رموز الصرح الجميل اوفسينا جزاك الله كل كل خير وفي ميزان حسناتك انشاء الله الله يوفقك ودمت في حفظ الله ورعايته تلميذك المحب أبو نصار