محمد طاهر عرفه

لا ادري ان ناسبك هذا الحل ام لا مع ملاحظة أنك ستحتاج لتحديث معادلة الصفيف لتحديث البيانات قبل الحصول على النتائج المحدثة Boo22222222k1.xls

اعتقد أن فهم الكود باتحاه عكسي دون معرفة اصل العمل سيكون أمرا صعبا و يستغرق جهد كبير ( على الاقل بالنسبة لي) أتمني ان يستطيع احد الاخوة ممن لديه خلفية عن موضوع الملف مساعدتك او اذا مطلوب تعديل معين سيكون الامر اسهل على الجميع مثلا عند الغط على زر --- اريد اضافة الكود الخاص ب ---- و الذي يعمل من زر -----

هذا هو الكود Private Sub UserForm_Initialize() Me.ListBox1.List = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value End Sub Private Sub FilterBasedonText_Click() Call TextBox1_AfterUpdate End Sub Private Sub TextBox1_AfterUpdate() Dim StrSearch As String Dim MyRowNo As Long StrSearch = "*" & UCase(Me.TextBox1.Text) & "*" With Me.ListBox1 For MyRowNo = .ListCount - 1 To 0 Step -1 If Not UCase(.List(MyRowNo)) Like StrSearch Then .RemoveItem (MyRowNo) End If Next End With End Sub Private Sub ShowAll_Click() Call UserForm_Initialize End Sub Private Sub RemoveSelected_Click() Me.ListBox1.RemoveItem (Me.ListBox1.Selected = True) End Sub و قد واجهتنى فيه مشكلة لفترة حيث كنت اسخدم فى البداية الكود التالي لتعبئة القائمة Private Sub UserForm_Initialize() Me.ListBox1.RowSource = "sheet1!a1:a" & Sheets("sheet1").Range("a" & Rows.Count).End(xlUp).Row End Sub ثم تبين أن أمر RemoveItem لا يعمل عند وجود بيانات فى Rowsource الخاص يالقائمة فتم الاستبدال بالكود الاول مرفق الملف اكتب النص المطلوب التصفية على أساسه فى المربع الأصفر ثم اضغط Enter او اضغط على زر Filter و لاظهار كافة البيانات اضغط Show All FilterListbox.xlsm

راجع هذا الموضوع

السلام عليكم تم تغيير مسمى عضو فعال الي عضو متميز و سيتم ترقية عدد من الأخوة الي هذه الدرجة قريبا باذن الله و يليها مباشرة بالترشيح و الاختيار يناء على المشاركة خبير معتمد و هما درجتي المسار الاحترافي فقط اما المسار الاداري فلا يوجد به حاليا الا مجموعة فريق الموقع ، و من يعتذر او يغيب من أعضاؤها كما هو معلن فى قواعد الترقبات ينقل مؤقتا الي مجموعة لوحة الشرف لاتاحة الفرصة لاسناد المهام الادارية لبديل لحين عودته و المسار الثالث و هو مسار عدد المشاركات فهو مسار ترقية آلي بناء على عدد المشاركات فقط و لا ترشيح فيه ، و فيه عضويات فضية و ذهبية و بلاتينية بناء على معيار واحد و هو عدد المشاركات و المعبر عن الاستمرارية و التفاعل

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

هل تريد الحفظ و التخلص من المرسالة ام عدم الحفظ و التخلص من الرسالة من الافضل ارفاق الملف للتجرية

و ان كنت لا افهم السبب جرب الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If ActiveCell.Column = 1 Then If ActiveCell.Value < 20 Then MsgBox "you must choose an item" ActiveCell.Offset(-1, 1).Activate SendKeys "%{DOWN}", True End If End If If ActiveCell.Column = 2 Then If ActiveCell.Offset(0, -1).Value < 20 Then If ActiveCell.Value = "" Then MsgBox "you must choose an item" SendKeys "%{DOWN}", True End If End If End If End Sub مرفق الملف test sheet (2).xlsm

يمكن استخدام معادلة IF لتحقيق المطلوب اذا فهمت ما تريد اذا اكبر أو يساوي من 20 لا ينتج شيء و اذا اكبر من 15 Large اكثر من 10 Medium اكثر من 5 small و طبعا يمكنك تعديل القيم كما تشاء =IF(D13>=20,"",IF(D13>=15,"Large",IF(D13>=10,"Medium",IF(D13>=5,"Small",)))) مرفق الملف test sheet.xlsx

من مجرر الأكواد Tools Options Editor Format و اختار اي خط عربي

و طبعا True للحفط عند الاغلاق False لعدم الحفظ

لتشغيل الكود المسمي pdf فى ملفك ( اسم الاجراء) اكتب السطر التالي فى الاجراء الاخر المطلوب ضمه اليه Call pdf

أجب ان اضيف انه في حالة الرغبة في غلق الملف دون غلق تطبيق الاكسيل نفسه ، في حال اذا كان اكثر من الملف مفتوح مثلا فيكتفي بالسطر الثاني فقط دون الأول Private Sub closeme() ActiveWorkbook.Close True End Sub

يمكن استخدام الدالة countif هكذا =COUNTIF(E8:M8,"غ") كما فى المثال المرفق غياب.xlsx سيتم الفصل فى موضوع مستقل

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

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

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

تمت الاضافة

بعض خفايا الوورد لمحبين الكتابة على الوورد

السلام عليكم بشأن الاكسيل ، اعتقد موضوعك فى قسم الاكسيل يمثل ما تريد تغيير كلمات بدون فتح الملف و يرجي التفاعل هنا بخصوص الوورد ففط ، لتعم الفائدة

السلام عليكم صراحة لم استخدمه سابقا ، هل الامتداد .7z و هل يفك هذا الامتداد برامج الضعط الاخرى ؟ اخشي الا يكون منتشرا بدرجة كافية و ان يواجه البعض مشكلة فى فك الملفات المضغوطة به اذا كانت الامور طيبة بخصوص ما سبق ، فساقوم بالاضافة باذن الله

السلام عليكم تعودنا فى منتدى اوفيسنا خلال السنوات الخمسة عشر الماضية على تحميل الملفات اما كصور او ملفات مضغوطة فقط بصيغتي rar , zip . و ذلك للحفاظ على المساحة و لسهولة رفع و تنزيل الملفات. الان يمكن تحميل انواع عديدة من الملفات كما هو موضح بالصورة ، و لكن ننصح بضغط الملفات في حالة المفات الكبيرة الحجم ايا كان امتدادها

السلام عليكم الكود السابق لا يتعلق بالمطلوب هذا حل قد يكون قريب مما تريد جرب الكود التالي : Sub CopyMyTable() Dim doc As Word.Document Dim tbl As Word.Table Dim rngTableTarget As Word.Range Set doc = ActiveDocument Set tbl = doc.Tables(1) Set rngTableTarget = doc.Content rngTableTarget.Collapse wdCollapseStart rngTableTarget.FormattedText = tbl.Range.FormattedText Selection.SplitTable End Sub و لتشغيله فى الملف المرفق قف فى خانة التاريخ اولا فى الجدول الاول ، ثم شغل الماكرو من القائمة او عن طريق CTR+o كشكول.rar

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

السلام عليكم تم عمل الاتي : 1- اضافة البحث و الاستبدال فى الرأس و التذييل Header & Footer ، مع ملاحظة ان ذلك ابطأ الملف الي حد ما ، فانتظر حتى تظهر رسالة الاستكمال و بها اسم المنتدى. 2- تم اضافة تصدير كل اوراق العمل الي ملفات PDF مستقلة باسم الملف وورقة العمل يمكن التحكم فى العديد من خصائص التصدير ، مثل وضع كلمة سر مثلا بحسب التفاصيل هنا الكود بعد التعديل Sub ReplaceInFolder() Dim strPath As String Dim strFile As String Dim ShFile As String ' short file name without extension Dim wbk As Workbook Dim wsh As Worksheet Dim strFind As String Dim strReplace As String strFind = InputBox("Enter text to find") If strFind = "" Then MsgBox "No find text specified!", vbExclamation Exit Sub End If strReplace = InputBox("Enter replacement text") With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then strPath = .SelectedItems(1) Else MsgBox "No folder selected!", vbExclamation Exit Sub End If End With If Right(strPath, 1) <> "\" Then strPath = strPath & "\" End If Application.ScreenUpdating = False 'Application.AlertBeforeOverwriting = False strFile = Dir(strPath & "*.xls*") Do While strFile <> "" Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False) For Each wsh In wbk.Worksheets 'replace in sheets wsh.Cells.Replace strFind, strReplace, xlPart, xlByColumns, False ' replace in header wsh.PageSetup.CenterHeader = Application.WorksheetFunction.Substitute( _ wsh.PageSetup.CenterHeader, strFind, strReplace) wsh.PageSetup.LeftHeader = Application.WorksheetFunction.Substitute( _ wsh.PageSetup.LeftHeader, strFind, strReplace) wsh.PageSetup.RightHeader = Application.WorksheetFunction.Substitute( _ wsh.PageSetup.RightHeader, strFind, strReplace) ' replace in footer wsh.PageSetup.CenterFooter = Application.WorksheetFunction.Substitute( _ wsh.PageSetup.CenterFooter, strFind, strReplace) wsh.PageSetup.LeftFooter = Application.WorksheetFunction.Substitute( _ wsh.PageSetup.LeftFooter, strFind, strReplace) wsh.PageSetup.RightFooter = Application.WorksheetFunction.Substitute( _ wsh.PageSetup.RightFooter, strFind, strReplace) wbk.Save ShFile = strPath & Left(wbk.Name, Len(wbk.Name) - 4) & Sheetcounter & "-" & wsh.Name ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ShFile _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False Next wsh wbk.Close SaveChanges:=True strFile = Dir Loop Application.ScreenUpdating = True 'Application.AlertBeforeOverwriting = True MsgBox "تم استكمال التصدير، مع تحيات" & Chr(10) & Chr(13) & "www.officena.net" End Sub مرفق الملف Replacer - 4 --.rar