عبدالله باقشير

اولا اجب على هذا السؤال ماذا وجدت في ملفي بعد فتح ادارة الاسماء ؟؟

السلام عليكم يااستاذي الفاضل انا طبقت كل خطواتك الكريمة في الملف المرفق ولكن ظهرت لي هذه الرسالة وارجو المساعدة لكي اعرف الخطأ أين وتقبل مني وافر الاحترام والتقدير. وعليكم السلام اذهب الى الملف الذي عملته انا وادخل على الاسماء اكسل 2003 : من القائمة ادراج .......الاسم .....تعريف اكسل احدث من 2003 : من القائمة صيغ ....ادارة الاسماء واخبرنا ماذا وجدت ؟ استاذي الغالي كل عام وانتم بالف خير.انا استعمل اوفس 2010 ولم اجد ادارة الاسماء.الله يبارك فيك استاذي ممكن تساعدني اكثر ولو بصورة توضيحية.

كل عام وانتم بخير جرب هذا Sub Macro1() Dim SM Dim pSheet As Worksheet Dim Lr As Long 'تعريف الشيت الذي سيتم نقل الارقام اليه Set pSheet = Sheets("Sheet3") ' مسح النطاق في الشيت المراد نقل البيانات اليه With pSheet .Range("A1").Resize(.Cells(Rows.Count, "A").End(xlUp).Row, 3).ClearContents End With ' صفحة البيانات الاولي With Sheets("Sheet1") Lr = .Cells(Rows.Count, "A").End(xlUp).Row pSheet.Range("A1").Resize(Lr, 2).Value = .Range("A1").Resize(Lr, 2).Value SM = "=SUM(" & Range("B2").Resize(Lr - 1).Address & ")" End With Lr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row - 1 With pSheet.Cells(Rows.Count, "A").End(xlUp) 'الرقم الاول بين القوسين يعبر عن ترتيب الصف والرقم الثاني يعبر عن ترتيب العمود .Offset(1, 0).Value = " اجمالي الاصول المتداولة " .Offset(1, 2).Value = SM .Offset(2, 0).Value = " الالتزامات المتداولة " .Offset(3, 0).Resize(Lr, 2).Value = Sheets("Sheet2").Range("A2").Resize(Lr, 2).Value SM = "=SUM(" & .Offset(3, 1).Resize(Lr).Address & ")" End With Lr2 = Sheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Row - 1 With pSheet.Cells(Rows.Count, "A").End(xlUp) .Offset(1, 0).Value = " اجمالي الالتزامات المتداولة " .Offset(1, 2).Value = SM .Offset(2, 0).Value = " الالتزامات طويلة الاجل " .Offset(3, 0).Resize(Lr2, 2).Value = Sheets("Sheet4").Range("A2").Resize(Lr2, 2).Value SM = "=SUM(" & .Offset(3, 1).Resize(Lr2).Address & ")" End With With pSheet.Cells(Rows.Count, "A").End(xlUp) .Offset(1, 0).Value = " اجمالي الالتزامات طويلة الاجل " .Offset(1, 2).Value = SM End With End Sub تحياتي

السلام عليكم يااستاذي الفاضل انا طبقت كل خطواتك الكريمة في الملف المرفق ولكن ظهرت لي هذه الرسالة وارجو المساعدة لكي اعرف الخطأ أين وتقبل مني وافر الاحترام والتقدير. وعليكم السلام اذهب الى الملف الذي عملته انا وادخل على الاسماء اكسل 2003 : من القائمة ادراج .......الاسم .....تعريف اكسل احدث من 2003 : من القائمة صيغ ....ادارة الاسماء واخبرنا ماذا وجدت ؟

السلام عليكم اثراءا للموضوع هذا اختصار لكود الاخ محمود الشريف ...........حفظه الله Sub MZM_ELSHRIEF() Dim R As Integer, RR As Integer Application.ScreenUpdating = False Range("A2:C20000").ClearContents RR = 2 With Sheet1 For R = 2 To .Cells(Rows.Count, "K").End(xlUp).Row If .Cells(R, "K").Value = 0 Then Cells(RR, "A").Resize(1, 3).Value = .Cells(R, "C").Resize(1, 3).Value RR = RR + 1 End If Next R End With Application.ScreenUpdating = True End Sub المرفق 2010 Classeur2_1.rar

السلام عليكم جزاكم الله خير وكل عام وانتم بخير تقبلوا تحياتي وشكري

وكل عام وانتم بخير تقبلوا تحياتي وشكري

وعليكم السلام من الافضل ارفاق ملف حتى يفهم المطلوب جيدا وتتم المعالجة فيه تحياتي

السلام عليكم ورحمة الله وبركاته جرب هذا Sub Macro1() Dim pSheet As Worksheet Dim Lr As Long Set pSheet = Sheets("Sheet3") With pSheet .Range("A1").Resize(.Cells(Rows.Count, "A").End(xlUp).Row, 2).ClearContents End With With Sheets("Sheet1") Lr = .Cells(Rows.Count, "A").End(xlUp).Row pSheet.Range("A1").Resize(Lr, 2).Value = .Range("A1").Resize(Lr, 2).Value End With Lr = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row - 1 With pSheet.Cells(Rows.Count, "A").End(xlUp) .Offset(1, 0).Value = "الالتزامات المتداولة" .Offset(2, 0).Resize(Lr, 2).Value = Sheets("Sheet2").Range("A2").Resize(Lr, 2).Value End With End Sub تحياتي شاهد المرفق 2010 نسخ البيانات من صفحتين الي صفحة واحدة.rar

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

السلام عليكم الشكر واصل لاخي الحبيب ياسر هذا بدون استخدام العمود P Sub مسلم() Dim c As Range Application.ScreenUpdating = False For Each c In Range("k6:k49") If CBool(InStr(c.Value, Range("L2"))) And Cells(c.Row, "j") = Range("c2") Then c.EntireRow.Hidden = False Else c.EntireRow.Hidden = True End If Next c Application.ScreenUpdating = True End Sub المرفق 2010 تحياتي بحث متقدم1.rar

السلام عليكم جرب هذا Sub Macro1() On Error GoTo 1 Workbooks.Open ThisWorkbook.Path & "\" & [A9] & ".xlsx" 1: End Sub تحياتي

السلام عليكم بدون داعي للمعادلة في العمود P =COUNTIFS($J$6:$J$1000;$C$2;$K$6:$K$1000;$L$2&"*") شاهد المرفق 2010 بحث متقدم1.rar

السلام عليكم ورحمة الله وبركاته جزاكم الله خيرا ملحوظة : لم اطلع بعد على البرنامج تقبلوا تحياتي وشكري

السلام عليكم جرب هذه =SUBTOTAL(103;$D$6:$D$49) تحياتي

السلام عليكم جرب هذه =MID(CELL("filename");SEARCH("]";CELL("filename"))+1;225) تحياتي

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

السلام عليكم بالنسبة لملائمة البيانات حسب ملفك تم التعديل في كود فتح الفورم هنا Sub kh_Show_UFormChang1() On Error GoTo 1 With UFormChang .kh_SetAddrss "البيانات", "B1:AD1", "A1" .Show End With 1: If Err Then MsgBox "تاكد من صحة ادخال المتغيرات الاساسية في : " & vbCr & vbCr & "kh_SetAddrss", vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "استخدام خاطىء" On Error GoTo 0 End Sub بالنسبة للطباعة عدل السطر الخاص بعنوان الخلايا في الكود المربوط بزر الطباعة وهو هذا Arr = Array("C6", "C9", "C13", "C17", "C20", "C20", "I6", "I9", "I13", "I17", "I20", "G23", "C26", "C33", "C36", "C39", "C42", "C45", "C48", "I33", "I36", "I39", "I42", "I45", "I48", "B55", "C55", "F55", "H55", "I55", "B58", "C58", "F58", "H58", "I58") تسلسل عنوان الخلية حسب تسلسل عرض البيانات في الفورم قم بذلك بنفسك ويمكنك تنسيق ورقة الطباعة حسب ما تريد المرفق 2003 الكون 1.rar

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم في اسمين معرفين لم تقم باضافتهما في هذا الملف شاهد المرفق 2003 قرعة 3.rar

السلام عليكم لإضافة ورقة جديدة إضغط الزر في شريط تبويب الاوراق (غير مستخدمي 2003) أو SHIFT+F11 او باستخدام كود لاضافة ورقة وتربطه بزر مثلا: Sub xxxx() Sheets.Add End Sub المهم انه في كل الحالات سيتم اضافة الورقة الجديدة حسب طلبك الكود موجود في ThisWorkbook ويمكنك تغيير تسمية الاشهر في الكود Private Sub Workbook_NewSheet(ByVal Sh As Object) Dim m, d, y, mAry Dim i As Long On Error GoTo 1 ' قم بتسمية الاشهر هنا حسب ما تناسبك mAry = Array("Jan", "Fév", "Mars", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") i = Sheets.Count If Sh.Index <> i Then Sh.Move , Sheets(i) d = Sheets(i - 1).Name m = Split(d, "-")(0): y = Split(d, "-")(1) m = WorksheetFunction.Match(CStr(m), mAry, 0) d = DateValue("13/" & m & "/" & y) d = DateSerial(Year(d), m + 1, 1) Sh.Name = mAry(Month(d) - 1) & "-" & Format(d, "yy") 1 End Sub المرفق 2003-2010 اضافة ورقة جديدة بتسمية معينة.rar تحياتي

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

السلام عليكم تم استخدام دالة معمولة بالكود kh_Names تجد موضوعها على الرابط http://www.officena.net/ib/index.php?showtopic=49057 المرفق 2010 ملف عينة.rar

السلام عليكم اخي الفاضل شوقي ربيع..........اكرمكم الله معلومات قيمة ...................جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري