أ / محمد صالح

بارك الله لك أخي أبا نصار استعمال للكود بطريقة تدل على فهم صائب وبارك الله لك أخي أحمد ربط بين المعادلات والكود رائع وأرجو أن يتسع صدرك للتعديل البسيط على الكود (فهوايتي اختصار الأكواد) Sub mSaveAs() If Range("H7") = False Then QQ = Range("J7") MsgBox QQ Exit Sub End If FN = Range("G7") ActiveWorkbook.SaveAs Filename:=FN End Sub للملاحظة تم الاستغناء عن سطري الذهاب إلى السطر رقم 9 والسطر نفسه واستبدالهما ب جملة الخروج من الإجراء

أخي الكريم الطريقة الأخيرة هي الأدق حسابياً ولكن نظام المرتبات يطلب أول رقمين بعد العلامة وهذا يتم بدالة trunc وإذا استعملت الطريقة الأخيرة و الدالة في المجموع فلن تكون النتائج دقيقة كما ينبغي والأفضل والصواب استعمال trunc في الجميع

أخي الكريم الجزيرة كود activeprinter هو الخاص بتنشيط طابعة معينة للطباعة عليها ولا يوجد غيره لعمل ذلك فإما أن يكون الخطأ في اسم الطابعة أو في اتصال الطابعة بالجهاز وتأكد أنه تظهر أسفل رمز الطابعة كلمة ready (جاهز) قبل الطباعة ولمعرفة اسماء الطابعات الموصلة بالجهاز يمكنك استعمال هذا الكود Private Const PRINTER_ENUM_LOCAL = &H2 Private Const PRINTER_ENUM_CONNECTIONS = &H4 Private Declare Function EnumPrinters Lib "winspool.drv" _ Alias "EnumPrintersA" _ (ByVal flags As Long, _ ByVal name As String, _ ByVal Level As Long, _ pPrinterEnum As Any, _ ByVal cdBuf As Long, _ pcbNeeded As Long, _ pcReturned As Long) _ As Long Private Declare Function StrLen Lib "kernel32" _ Alias "lstrlenA" _ (ByVal Ptr As Long) _ As Long Private Declare Function StrCopy Lib "kernel32" _ Alias "lstrcpyA" _ (ByVal RetVal As String, _ ByVal Ptr As Long) _ As Long Private Function CopyStringFromPtr(ByVal pSource As Long) As String CopyStringFromPtr = Space$(StrLen(pSource)) StrCopy CopyStringFromPtr, pSource End Function Public Function GetPrinterNames() As Variant Dim fSuccess As Boolean, lBuflen As Long, lFlags As Long Dim aBuffer() As Long, lEntries As Long Dim iCount As Integer, aPrinters() As String lFlags = PRINTER_ENUM_LOCAL Or PRINTER_ENUM_CONNECTIONS Call EnumPrinters(lFlags, vbNullString, 1, 0, 0, lBuflen, lEntries) ReDim aBuffer(lBuflen \ 4) fSuccess = EnumPrinters( _ lFlags, _ vbNullString, _ 1, _ aBuffer(0), _ lBuflen, _ lBuflen, _ lEntries) <> 0 If fSuccess And lEntries > 0 Then ReDim aPrinters(lEntries - 1) For iCount = 0 To lEntries - 1 aPrinters(iCount) = CopyStringFromPtr(aBuffer(iCount * 4 + 2)) Next GetPrinterNames = aPrinters End If End Function Public Sub GetPrinterList() Dim aPrinters As Variant, i As Integer aPrinters = GetPrinterNames If IsArray(aPrinters) Then For i = 0 To UBound(aPrinters) Debug.Print aPrinters(i) Next End If End Sub لذلك يجب أولا التأكد من توصيل الطابعة وجاهزيتها وثانيا اسمها الصحيح ثم تستعمل activeprinter وفقنا الله وإياكم لكل خير

إذا كان الأمر كذلك فيمكنك استعمال الدالة trunc =trunc(a1*10%,2) حيث a1 هو الرقم المراد ضربه في 10% و ال 2 هو عدد الأرقام على يمين العلامة العشرية

أخي الكريم مجدي يونس في أي خلية بالضبط صادفت ذلك؟؟!! ففي الملف المرسل مني يتم قص أول رقمين بعد العلامة العشرية بدون تقريب في نسبة ال 10% وال 30% ومن الطبيعي ألا ينتج رقم به ثلاثة أرقام على يمين العلامة العشرية من حاصل جمع أرقام هي في الأصل رقمين على يمين العلامة ............. لا تقلق الآلية التي يمشي بها الملف صحيحة وإن صادفت ذلك فأين وجدته للوصول للحل وفقنا الله وإياكم لكل ما يحب ويرضى

جرب أن تستعمل المسار الكامل Application.ActivePrinter="EPSON LQ-690"

ما نص رسالة الخطأ؟ أو يمكنك تصويرها بزر print screen

أخي الكريم الجزيرة تتم الطباعة على الطابعة الافتراضية لا على طابعة أخرى مهما يكون عدد الطابعات الموصل بالجهاز ولا ستعمال طابعة غير الافتراضية يجب تنشيطها أولا باستعمال ActivePrinter = "EPSON LQ-690" ثم أمر الطباعة

بارك الله لك أخي يحياوي على اجتهادك وبحث وحرصك على إفادة إخوانك ولمن لا يجيد الإنجليزية هذا رابط لترجمة الكتاب http://translate.google.com.eg/translate?sl=auto&tl=ar&js=n&prev=_t&hl=ar&ie=UTF-8&layout=2&eotf=1&u=http%3A%2F%2Fwww.xlpert.com%2Ftoc.htm أتمنى أن يفيدنا جميعاً

الحمد لله على عمل البرنامج مع جميع الإخوة اللهم علمنا ما ينفعنا وانفعنا بما علمتنا

بالفعل أخي الكريم مجدي الدالة int تجبر ما فوق النصف إلى واحد صحيح الصواب الدالة floor شاهد المرفق mas_splitnum3.rar

تفضل أخي مجدي وكنت أتمنى أن تستنتجها أنت بحكم خبرتك معنا في أوفيسنا ولكن يبدو أنك لم تحاول mas_splitnum2.rar

تفضل أخي الكريم تم إضافية عمود وتم تطبيق المطلوب على عمودين وطبعاً يمكنك التطبيق على باقي الأعمدة أتمنى أن تكون الفكرة وضحت mas_splitnum.rar

شكرا لجميع الإخوة الذين عمل البرنامج معهم أما أخي tahar وأخي خبور خير فيبدو أن الجهاز يحتاج لبعض التحديث وخاصة dotnetframework إلى نسخة 3.5 sp1 أو 4 هذا رابط 3.5 http://download.micr.../dotnetfx35.exe وهذا رابط للنسخة 4 http://www.microsoft...s.aspx?id=17718 وفقنا الله وإياكم لكل ما يحب ويرضى

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

تفضل أخي الكريم Dim fctrl As Control For Each fctrl In Me.Controls If fctrl.Name Like "Text*" Or fctrl.Name Like "Combo*" Then fctrl = vbNullString Next

أشكر لكم مروركم الكريم اخوتي و أحبتي في الله نفعنا الله وإياكم بما علمنا وعلمنا ما ينفعنا

بارك الله لك أخي الكريم محمد يحياوي رابع زر في الرسالة هو زر التعليمات (help) إذا تم تضمينه مع رسالة بها 3 أزرار

موعدنا اليوم مع تطبيق ضمن سلسلة ما خف وزنه وغلا ثمنه لأحبابي أعضاء وزوار منتدى أوفيسنا تطبيق يساعدك في إنشاء رسائل msgbox بصورة احترافية فقط اختر الأزرار والعنوان ونص الرسالة والأيقونة وباقي الخيارات ثم اضغط على زر تجربة لمشاهدة كود الرسالة ثم قم بنسخ الكود لبرنامجك ويمكنك استخدام الثوابت والقيم في كتابة الكود وفي الأخير لا ينقصني سوى دعاؤكم msgboxbuilder.rar

ما شاء الله رائع أخي خبور خير وهذا رابط للإخوة هواة ألعاب الإكسل http://excelgames.org

أشكركم جميعاً إخوتي وأحبتي في الله وهذا الجزء العملي 2 من الفصل الرابع في الدورة وفقنا الله وإياكم لكل ما يحب ويرضى

آمين ولك مثلها أخي أحمد بارك الله لك ونفع بك

هذا ما قلته أنا فلربما يحتاج ذلك أحد الإخوة ولعمل ما تريد استبدل هذا السطر With ActiveSheet.Range("a2").Validation بالتالي With sheets("mas").Range("a2").Validation حيث mas هو اسم الشيت الذي تريد وضع القائمة فيه

بارك الله لك أخي العيدروس (أبا نصار) وهذه مساهمة من العبد لله لحل مثل هذا المشكل ضع هذا الكود في الجزء الخاص بالمصنف thisworkbook Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim ws As Worksheet, sheetlist As String For Each ws In ActiveWorkbook.Sheets sheetlist = sheetlist & ws.Name & "," Next With ActiveSheet.Range("a2").Validation .Delete .Add xlValidateList, Formula1:=Left(sheetlist, Len(sheetlist) - 1) End With End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Range("a2").Value <> "" Then Sheets(Range("a2").Value).Select End Sub وهو لوضع قائمة بأسماء الشيتات في الخلية a2 من كل الشيتات وبفضل الله القائمة ذاتية التحديث بحيث إذا تمت إضافة شيت أو حذف شيت يظهر أو يختفي من القائمة في الحال وعند الاختيار من القائمة يتم الانتقال للشيت الذي تم اختياره جرب أخي وأخبرني بالنتيجة

بسم الله الرحمن الرحيم الجزء العملي من الفصل الرابع (الكائنات objects ) ويبقى جزء بسيط قريباً إن شاء الله ولا ينقصني سوى دعاؤكم