مختار حسين محمود

بسم الله الرحمن الرحيم بداية السلام عليكم ورحمة الله وبركاته باختصار مدارس المرحلة الابتدائية غدا فى مصر تجرى اختبار قرائية على مستوى الجمهورية وقد طلبت الادارات التعليمية من المدارس الابتدائية النتائج على ملف اكسل وورد بالاضافة الى وضع ذلك على النت طريقة تحويل ملف الاكسل الى الوورد : الكود المستخدم منقول من الرابط http://www.thespreadsheetguru.com/blog/2014/5/22/copy-paste-an-excel-table-into-microsoft-word-with-vba وهذه صورة الكود : Sub ExcelRangeToWord() 'PURPOSE: Copy/Paste An Excel Table Into a New Word Document 'NOTE: Must have Word Object Library Active in Order to Run _ (VBE > Tools > References > Microsoft Word 12.0 Object Library) 'SOURCE: www.TheSpreadsheetGuru.com Dim tbl As Excel.Range Dim WordApp As Word.Application Dim myDoc As Word.Document Dim WordTable As Word.Table 'Optimize Code Application.ScreenUpdating = False Application.EnableEvents = False 'Copy Range from Excel Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects("Table1").Range 'Create an Instance of MS Word On Error Resume Next 'Is MS Word already opened? Set WordApp = GetObject(class:="Word.Application") 'Clear the error between errors Err.Clear 'If MS Word is not already open then open MS Word If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application") 'Handle if the Word Application is not found If Err.Number = 429 Then MsgBox "Microsoft Word could not be found, aborting." GoTo EndRoutine End If On Error GoTo 0 'Make MS Word Visible and Active WordApp.Visible = True WordApp.Activate 'Create a New Document Set myDoc = WordApp.Documents.Add 'Copy Excel Table Range tbl.Copy 'Paste Table into MS Word myDoc.Paragraphs(1).Range.PasteExcelTable _ LinkedToExcel:=False, _ WordFormatting:=False, _ RTF:=False 'Autofit Table so it fits inside Word Document Set WordTable = myDoc.Tables(1) WordTable.AutoFitBehavior (wdAutoFitWindow) EndRoutine: 'Optimize Code Application.ScreenUpdating = True Application.EnableEvents = True 'Clear The Clipboard Application.CutCopyMode = False End Sub لم يعمل الكود حتى بعد اضافة المكتبة Microsoft Word 12.0 Object Library وقمت بتطويره كما يلى : Sub ExcelRangeToWord() 'PURPOSE: Copy/Paste An Excel Table Into a New Word Document 'NOTE: Must have Word Object Library Active in Order to Run (VBE > Tools > References > Microsoft Word 12.0 Object Library) 'SOURCE: http://www.thespreadsheetguru.com/blog/2014/5/22/copy-paste-an-excel-table-into-microsoft-word-with-vba Dim tbl As Excel.Range Dim WordApp As Word.Application Dim myDoc As Word.Document Dim WordTable As Word.Table 'Optimize Code Application.ScreenUpdating = False Application.EnableEvents = False 'Copy Range from Excel Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).Range("Table1") 'Create an Instance of MS Word On Error Resume Next 'Is MS Word already opened? Set WordApp = GetObject(class:="Word.Application") 'Clear the error between errors Err.Clear 'If MS Word is not already open then open MS Word If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application") 'Handle if the Word Application is not found If Err.Number = 429 Then MsgBox "Microsoft Word could not be found, aborting." GoTo EndRoutine End If On Error GoTo 0 'Make MS Word Visible and Active and WindowState Minimize WordApp.Visible = True WordApp.WindowState = wdWindowStateMinimize 'Create a New Document Set myDoc = WordApp.Documents.Add 'Copy Excel Table Range tbl.Copy 'Paste Table into MS Word myDoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False 'PageSetup into MS Word With ActiveDocument.PageSetup .LineNumbering.Active = False .Orientation = wdOrientLandscape .TopMargin = CentimetersToPoints(1) .BottomMargin = CentimetersToPoints(1) .LeftMargin = CentimetersToPoints(1) .RightMargin = CentimetersToPoints(1) End With 'Autofit Table so it fits inside Word Document Set WordTable = myDoc.Tables(1) WordTable.AutoFitBehavior (wdAutoFitWindow) 'save Word Document as With ActiveDocument ChangeFileOpenDirectory (ThisWorkbook.Path) ' or use this line : ChangeFileOpenDirectory "H:\ " * change path ActiveDocument.SaveAs2 Filename:="document from excel by mohtar.doc" 'change Filename End With 'CLOSE Word Application With WordApp .ActiveDocument.Close .Quit End With Set WordApp = Nothing EndRoutine: 'Optimize Code Application.ScreenUpdating = True Application.EnableEvents = True 'Clear The Clipboard Application.CutCopyMode = False MsgBox (" congratulation your excel File saved as to Word Document ") End Sub ملحوظتان فى غاية الأهمية : الأولى : اضافة المرجع ده Microsoft Word 12.0 Object Library لمنع توقف الكود وذلك طبقاً للخطوات الاتية : VBE > Tools > References > Microsoft Word 12.0 Object Library الثانية تسمية المدى الذى تريد تحويله الى الوورد Table1 والمرفق التالى يوضح ذلك طريقة تحويل الاكسل الى الوورد أقدمه هدية لزملائى ليستفيدوا به فى امتحان القرائية تحياتى للجميع Export Excel to word document.rar

بارك الله فيك أستاذى الفاضل سليم أخى اكرامى وهذا حل آخر للترحيل والفلترة بالأكواد تحياتى ترحيل2.rar

تم تجربة الملف الأخير يعمل بنجاح

أولا لوحضرتك عايز الاكسل يقفل على صفحة معينة استخدم الكود التالى Private Sub Workbook_BeforeClose(Cancel As Boolean) '*** اختر اسم الشيت الذى تريد ه ********* Sheet1.Activate '****************************************** End Sub ثانيا حضرنك بتقول بعض الاشخاص يستخدم التاسك بار فى هذا الغرض ما دخل التاسك بار وهذا الغرض وما دخل التاسك منجر بهذا كله أرجو التوضيح

الله ينور عليك أخى صلاح وفيه طلب من ادارة المنتدى : فى شريط العناوين المتحرك أعلى المنتدى تتداخل الموضوعات ( الاكسل مع الآكسس ) ويترتب عليه أحيانا كثيرة أختار موضوع وأدخل ألاقى نفسى فى الأكسس وأضطر للعودة الى الاكسل مرة أخرى فنتمى من الادارة التفريق باللون أو أى شىء آخر بين موضوعات الاكسل و موضوعات الآكسس فى شريط العناوين حتى يسهل علينا انتقاء الموضوعات

وأنا مثلك منتظر حد يفيدنا بقالى 3 أيام بدور على اجابة و مش لاقى حاجة نافعة حضرتك عايز تلغى CTRL + ALT + DELETE الخاصة باستدعاء taskmgr ليــــــــــــــــــــــــــه ؟! ما الفكرة ولا مجرد رغبة فقط ؟

شوف المشاركة 11 هناك

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

أخى أحمد جرب الملف ده لديك 5 مستخدمين للملف A كلمة السر 1 B كلمة السر 2 C كلمة السر 3 D كلمة السر 4 E كلمة السر 5 أرجو أن ينال اعجابك USER PASS A1 B2 C3 D4 E5.rar

أحسنت وبارك الله فيك تحياتى

بيل جيتس ؟! بيل جيتس ؟! هو جاى امتى ؟ جاى الساعة 6 راكب ولا ماشى ؟ راكب بسكلته

أخى الكريم أبا القاسم الكود فى المرفق الخاص بى هو لدالة مستحدثة تقوم بعمل تسلسل تلقائى فى عمود طبقا للصفوف المتاحة فى الشيت سواء قبل الفلترة أم بعد الفلترة وصيغة الدالة ( AUTONUMBER( A1 = حيث A1 هى الخلية التى تبدأ بالتسلسل طبق على العمود A المعادلة واعمل فلترة حسب ما تريد هتلاقى التسلسل هيمشى كالتالى 1 2 3 4 ........الخ بعد أى فلترة

ROUNDDOWN أيضا بتقرب تمام و ماشى الحال بس لا زال السؤال قائم ليه تم اضافة الدوال المتشابه دى الى الاكسل مش الأفضل اضافة دوال جديدة مستحدثة وتريحنا مايكرسوفت بدل ما نقعد ندور عليها هنا وهناك ولا ايه رأيكم ؟

نعم هو كذلك فعليكم بـــ 2010 بصراحة لم أجد أفضل منه

بارك الله فيك أستاذى الفاضل محمد وجازاكم عنا خيرا أنا ضعيف فى المعادلات ولى استفسار و فى ناتج المعادلة ( QUOTIENT(B2;C2 = الكسر الزائد ده بيروح فين يحذف أم يتم تجاهله أم يقرب أم ماذا ؟ واذا كان يقرّب فما الفرق بين الدالتين اذن طالما العمل و الناتج واحد ؟! وما الفرق بين إرجاع جزء العدد الصحيح لناتج القسمة و تقريب الرقم الى اقرب عدد صحيح ؟! تحياتى

زى ما قلت لك عشان أنت تستعمل win7 64 bit والكود يعمل على نظام 32 بت وتعديل التصريحات لكى تتناسب مع أنظمة 64 أمر ليس سهلا يحتاج مبرمجين اذا لم توفق فى الحل استخدم نظام 32 بت فهو الاكثر انتشارا وأغلب البرامج تعمل عليه .

هذا المرفق به ماكرو مسجل على 2010 لعمل group بين button و Shape group ماكرو لعمل.rar

أستاذى الحبيب ياسر أعمل على mso 2010 اذا طبقت الخطوات السابقة فى مشاركتى رقم 2 هتلاقى الــــ Button و الشكل التلقائى فد تم ربطهما معا فى group واحد اذا حركت أى منهما فان الثانى يتبعه نظرا للترابط الذى حدث سواء الشكلين مختلفين أو من نوع واحد ولو كنت أعرف أعمل فيديو للشرح كنت عملته لانى لم أجرب ولم أحاول تحياتى لك

بداية جيدة خاصة مع استخدام الصور فى الشرح بس ياريت تكمل الجميل و ترفق ملفاً صغيرا مصحوبا بالصور ليستفيد به حديثى التعامل مع اكسل تحياتى

تفضل أخى الكريم اعمل أى فلترة هتلاقى التسلسل تلقائى ان أعجبك اختر الاجابه كأفضل اجابة للتسلسل التلقائى بعدالفلترة.rar

عشان أنت تستعمل win7 64 bit والكود يعمل على نظام 32 بت وتعديل التصريحات لكى تتناسب مع أنظمة 64 أمر ليس سهلا يحتاج مبرمجين جرب تعديل المكتبات المستدعاة فى الكود من user32 الى user64 والله أعلى وأعلم

أستاذ أحمد السلام عليكم اذا أرفقت ملفاً يبقى أفضل للعمل عليه اذا كان الملف واحداً والمستخدمين متعددين والكل يشترك فى العمل على الملف جرب هذا المرفق ملحوظة فى المرفق صلاحيات لـ 3 مستخدمين اختر واحدا وادخل الى الملف بالسرى 2014 المرفق يمكن من خلاله تعديل المستخدمين واضافة آخرين جدد وبكلمات سر مختلفة أما اذا كنت تريد عمل صلاحيات لموظفين لإدخال البيانات فقط الى الملف ونمنعهم من التدقيق والطباعة وصلاحيات لآخرين لتدقيق البيانات فى الملف فقط ونمنعهم من الادخال والطباعة وصلاحيات لآخرين لطباعة التقارير فقط ونمنعهم من الادخال والتدقيق هل تقصد ذلك اذا كنت تقصد ذلك فهذا يحتاج وقفة وبحث تحياتى شاشة دخول لأكثر من مستخدم والسرى 2014 وممكن تعديله.rar

جرب ده أفضل تمريرة سريعة على الصورة وابعد حتى لا يتكرر استدعاء الكود ويحصل الاهتزاز بعد 3 ثوانى من ظهور الأعمده هتلاقيها اختفت لوحدها حسب الكود ده الموجود فى حدث الورقة Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Columns("r:x").Select Selection.EntireColumn.Hidden = False Range("a1").Select Application.OnTime Now + TimeValue("00:00:03"), "SHOW_COL" End Sub يمكن تغيير المدة الزمنية التى تختفى بعدها الأعمدة فى الكود السابق الكود السابق يستدعى الكود العادى ده Sub SHOW_COL() ActiveSheet.Columns("s:w").Hidden = True Range("a1").Select End Sub اذا كان الحل يروقك اختره كأفضل اجابة تحياتى اظهار واخفاء بمجرد الوقوف على الزر - 2.rar

تفضل أخى الكريم group button and Shape.rar

أتقدم بالتهنئة للأخ والأستاذ الحبيب/ ياسر خليل ألف مبروووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووك وفقك الله لما يحبه ويرضاه