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

السلا عليكم ورحمة الله وبركاته شهر مبارك وكل عام وانتم بخير كود لتحويل المعادلات الى قيم Option Explicit Sub Kh_Formula_To_Value() Dim MyCalcu As XlCalculation With Application MyCalcu = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With '===================================== '////////////////////////////////////// '===================================== ' هنا تضع النطاق والمعادلة التي تريد تحويلها قيم ' Formula_To_Value باستخدام '===================================== ' T هنا المعادلة اللي في العمود Formula_To_Value Range("T5:T30"), "=RC[-2]*RC[-1]" ' x هنا المعادلة اللي في العمود ' مثل عمل كود الاخ كيماس Formula_To_Value Range("X5:X30"), "=IF(COUNTIF(RC16:R30C16,RC16)=1,SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20)),"""")" ' Y هنا المعادلة اللي في العمود Formula_To_Value Range("Y5:Y30"), "=SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20))" '===================================== '////////////////////////////////////// '===================================== With Application .ScreenUpdating = True .Calculation = MyCalcu End With End Sub ================================================= Sub Formula_To_Value(MyRng As Range, MyFormula As Variant) With MyRng .ClearContents .Formula = MyFormula .Cells = .Value End With End Sub وهو طلب احدهم في الموضوع http://www.officena.net/ib/index.php?showtopic=37827 المرفق ملف اكسل 2003 كود تحويل المعادلات الى قيم.rar

======================== الاخ الحبيب/ ابو عبدالله ======================== و =================================== شهر مبارك وكل عام وانتم بخير ===================================

السلام عليكم رد يحياوي صحيح عند تحديد الخلايا يجب تحديد نطاق واحد فقط استبدل الكود في موديل 2 بهذا Option Explicit Sub Kh_Save_Picture() Dim MyCount As Integer Dim P As String If TypeName(Selection) = "Range" Then If Selection.Areas.Count > 1 Then _ MsgBox "يجب تحديد نطاق واحد فقط", vbMsgBoxRtlReading + vbExclamation _ : Exit Sub End If Do MyCount = MyCount + 1 P = ActiveWorkbook.Path & "\" & MyCount & ".bmp" Loop While Not Dir(P, vbDirectory) = vbNullString Selection.CopyPicture xlScreen, xlBitmap Call DoTheWork(P) On Error GoTo 1 MsgBox "تم حفظ الصورة في الرابط ادناه" & vbCr & vbCr & P ActiveWorkbook.FollowHyperlink P, , True 1 End Sub واشعرنا بالناتج

الاخوة الافاضل والحبايب KHMB ياسر الحافظ يحياوي يوسف عطا طاهر khhnna محمد هشام شلبي عبدالله المجرب حسن علي عادل يحي لكم من كل قلبي و مبارك عليكم الشهر الكريم وكل عام وانتم بخير

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

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

السلام عليكم كود لاظهار الرسام mspaint Sub kh_mspaint() Dim ReturnValue ReturnValue = Shell("c:\windows\system32\mspaint.exe", 3) End Sub

السلام عليكم كود لالتقاط صورة للشاشة Sub PrintTheScreen() Application.SendKeys "(%{1068})" DoEvents End Sub

اعتقد الطلب صعب والله اعلم

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

السلام عليكم العرض القياسي للاعمدة في الورقة=0 لاعادة العرض القياسي الافتراضي للاعمدة Sub Macro1() ActiveSheet.StandardWidth = 8.43 End Sub ولعكس العملية Sub Macro2() ActiveSheet.StandardWidth = 0 End Sub او غيره يدويا من محرر الفيجوال بالضعط ALT+F11 كما في الصورة مكان الدائرة الحمراء

السلام عليكم كود لاظهار واخفاء الاعمدة امر واحد يعكس العملية وممكن استخدامه في اكثر من خاصية مشابهة Sub kh_Hidden() With Range("F1,K1,P1,U1,Z1") .EntireColumn.Hidden = Not .EntireColumn.Hidden End With End Sub

السلام عليكم الشكر واصل للاخ الحبيب هشام ممكن استخدام الكود التالي للاخفاء والاظهار معا Sub kh_Hidden() With Range("F1,K1,P1,U1,Z1") .EntireColumn.Hidden = Not .EntireColumn.Hidden End With End Sub

الاخ الحبيب/ ياسر الحافظ و

======================== الاخ الحبيب/ يحياوي ========================

لعله بخير إن شاء الله

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

======================== الاخ الحبيب/ عادل ======================== مجهود اكثر من رائع وفي زمن قياسي ======================== و

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

وعليكم السلام مثلا لو اردنا امر معاينة الطباعة عندك في الفورم الرقم 222 Sub kh_showDialog_222() Application.Dialogs(222).Show End Sub مثلا اعجبني الامر ده لعمل قائمة او لست في خلية توخد من نفس العمود عملت الكود هذا ليناسها ============================================================ Option Explicit Private Const stRng As String = "B4:B32" Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next If Me.CheckBox1.Value = True Then Exit Sub If Not Intersect(Target.Cells, Range(stRng).Cells) Is Nothing Then If Target.Cells.Count > 1 Then Exit Sub If Target.Row = Range(stRng).Row Then Exit Sub If Len(Target.Offset(-1, 0)) Then Application.Dialogs(491).Show End If End If On Error GoTo 0 End Sub يوضع في حدث الورقة قائمة في خلية للقيم الفريده في نفس العمود.rar

السلام عليكم ورحمة الله وبركاته للوصول السريع الى فتح صناديق الحوار او الاوامر ده الفورم يعطيك الرقم سريعا XlBuiltInDialog هو في ارقام كثيرة لكن حاولت ان اجمع ما يفتح بالامر Show اختار الرقم وضعه بدل الكلمة هنا Application.Dialogs(هنا).Show في اوامر لم اضع تسميتها دمتم في حفظ الله Application.Dialogs1.rar =================================================== النسخة الجديدة بجميع الاوامر من 1 الى 119 ممكن تستخدم معها الامر Show وهي الملونة في الشيت وهي التي تم اختبارها وترجمتها مني ومن الاخ عادل Application.Dialogsadel3.rar =================================================== رابط ذو اهمية: http://msdn.microsoft.com/en-us/library/ff194519.aspx

======================== الاخ الحبيب/ هشام شلبي ======================== و

======================== الاخ الحبيب/ الحسامي ======================== و

السلام عليكم ورحمة الله وبركاته تعديل جديد في المحفظة تجدونه في الرابط ادناه مع الشكر الجزيل للاخ يحياوي http://www.officena.net/ib/index.php?showtopic=37670

======================== الاخ الحبيب/ يحياوي ======================== و ========================================== هديتي لك نسخة مما قمت به مع تعديل ملف المحفظة الميزة الجديدة فيه: انه لا يغلق بعد الخروج من الفورم ارجوا ان تكمل العمل في هذا الفورم اذا نال رضاك ========================================== محفظة اكواد1.rar