نجوم المشاركات

بارك الله فيك استاذى سليم معادلة رائعة بعد اذن حضرتك ولإثراء الموضوع هذه معادلة اخرى =TEXT(INT(SUM($B$13*B$9)/60)&":"&MOD(SUM($B$13*B$9),60),"hh:mm")

هذه المعادلة =(QUOTIENT((B13*B9),60)&":"&MOD(B13*B9,60))

مشاركة مع استاذ صالح اليك هذا الرابط به طريقتين

السلام عليكم ورحمة الله جرب المرفق لعل فيه ما تريد.... حاجي بن علية معادلة من ثلاثة شروط.xlsx

ممتاز صديقي الكود حاليا يعمل بشكل جيد الكود التالي أنا أستعمله منذ يومين و لم يظهر لي أي مشكل بعد لكن لا أدري لست مرتاحا له كثيرا. Dim WshShell As Object Set WshShell = CreateObject("wscript.shell") WshShell.SendKeys "{End}" Set WshShell = Nothing و الظاهر أنني سوف أستعمل مثالك ما لم يظهر أي مشكل شكرا جزيلا صديقي العزيز

السلام عليكم ورحمة الله معادلة أخرى تفي الغرض المطلوب: =IFERROR(INDIRECT("B"&IF($A$1<=12;CHOOSE(MOD($A$1-2;6);1;2;3;4);""));"No Data") أو =IFERROR(INDIRECT("B"&IF($A$1<=12,CHOOSE(MOD($A$1-2,6),1,2,3,4),"")),"No Data") الملف المرفق فيه كل الحلول المقترحة في الموضوع (حتى الآن) بن علية حاجي الحلول.xlsx

طريقة اخرى =IFNA(INDIRECT("b"&MATCH(1;(--({3,4,5,6}=A1))+(--({9,10,11,12}=A1));0));"")

استعمل احد هاتين المعادلتين (حسب اعدادات الجهاز عندك الفاصلة او الفاصلة المنقوطة) اذا لم تعمل الاولى سوف تعمل الثانية =IFERROR(INDIRECT(VLOOKUP($A$1,{3,"B1";9,"B1";4,"B2";10,"B2";5,"B3";11,"B3";6,"B4";12,"B4"},2,0)),"No Data") =IFERROR(INDIRECT(VLOOKUP($A$1;{3,"B1";9,"B1";4,"B2";10,"B2";5,"B3";11,"B3";6,"B4";12,"B4"};2;0));"No Data") الملف مرفق Equation.xlsx

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

أهلين أخي فين هذا الغياب

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

السلام عليكم ورحمة الله يمكن أيضا الاستغناء عن الدالة CHOOSE في المعادلة السابقة لتكون بالشكل المختصر التالي: =IFERROR(INDIRECT("B"&IF($A$1<=12;MOD($A$1-2;6);""));"No Data") أو =IFERROR(INDIRECT("B"&IF($A$1<=12,MOD($A$1-2,6),"")),"No Data") بن علية حاجي

وعليكم السلم ورحمة الله وبركاته في خصائص المجموعة فرض صفحة بعد المقطع للتجميع الخاص بالإدارات = نعم

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

هلا صديقي عادة اخر شيء نفكر به هو استخدام SendKeys اليك الحل الشافي لهذه الظاهرة ان شاء الله تفضل : testNum.rar

انت مخير اما ان تزيل الاقواس او تحدد النداء بـــ Call Call DB_Backup(SQLServerName, DatabaseName, UserName, Password, DeviceName, BackupName, BackupDiscription) 'DB_Backup SQLServerName, DatabaseName, UserName, Password, DeviceName, BackupName, BackupDiscription db1.mdb

استاذ سلطان انا بعت لحضرتك على الاميل الاول والملف وصل وتم الاستلام وحضرتك اللى اعطتينى الاميل بتاعك خطأ هذا ليس ذنبى ولك تحياتى

الاستاذ عبداللطيف شكراً على مبادرتك ما أردته هو عملية تصفية سواء بالكلمة كلها او بجزء منها في نموذج مستمر. مع جزيل الشكر

حلوة طلة الأحبة

السلام عليكم الكود التالي يمكنك من معرفة هل يوجد اختصار على سطح المكتب أو لا: Dim curPath As String curPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\tt.lnk" If Len(Dir(curPath, vbDirectory)) <> 0 Then MsgBox 1 Else MsgBox 0 End If اسم الاختصار هو tt إذا كان هناك اختصار تظهر رسالة بها 1 و إذا لم يكن هناك إختصار تظهر رسالة بها 0 جرب الكود و أطلعنا على النتيجة

السلام عليكم ورحمة الله استخدم هذا الكود Sub ImportData() Dim ws As Worksheet, Sh As Worksheet Dim i As Integer, x As Integer, day As String Set ws = Sheets("التقرير اليومي") Set Sh = Sheets("بيانات") day = ws.Range("G4").Value ws.Range("E107:L151").ClearContents For i = 19 To 67 Step 12 If Sh.Cells(3, i).Value = day Then x = i + 7 Sh.Activate Sh.Range(Cells(5, i), Cells(49, x)).Copy ws.Activate ws.Range("E107").PasteSpecial xlPasteValues ws.Range("E105") = day End If Next ws.Range("G4").Select Application.CutCopyMode = False End Sub

يا جماعة لو سمحتو اتأكدو من الايملات لان عند الارسال لم يتم التعارف على الاميل وياريت بكون gmail وللجميع تحياتى

استاذ ابو خالد لم يتم التعارف على الاميل بتاعك لك تحياتى

أستاذى ابو خالد البرنامج يعمل معى بكل كفاءة أو يمكنك تحميله من هذا الرابط https://www.officena.net/ib/topic/66357-برنامج-العطاء-للعقارات/

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

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

خطر لي ايضا بالنسبة للاستبدال أنه يمكن استخدام احدي خاصيتي ال autocorrect or autotext و لكن بعد ردك الاخير ، فلا طريق امامك الا استبدال الخط للمسافة و الله أعلم و هذا وارد تنفيذه ايضا من من Edit Replace او CTR+H و نستبدل المسافة بمسافتين مع تغيير الخط

السلام عليكم ورحمة الله ممكن بأمر الاستبدال اضغط Ctrl+H ثم اكتب في السطر الأول p^p^ وفي السطر الثاني p^ والله أعلم

Sub الماكرو_الرئيسي() أعمدة جدول_الضرب End Sub Sub جدول_الضرب() Dim sumNomber As Integer Dim i As Integer Dim i2 As Integer For i = 1 To 20 For i2 = 1 To 10 sumNomber = i * i2 Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter Selection.BoldRun Selection.Font.SizeBi = 16 Selection.Font.BoldBi = wdToggle Selection.TypeText Text:=i & " × " & i2 & " = " & sumNomber Selection.TypeParagraph Next Selection.TypeText Text:="-------------" Selection.TypeParagraph Next Selection.TypeText Text:="============" End Sub Sub أعمدة() With ActiveDocument.PageSetup.TextColumns .SetCount NumColumns:=3 .EvenlySpaced = True .LineBetween = True .Width = CentimetersToPoints(4.05) .Spacing = CentimetersToPoints(1.25) .FlowDirection = wdFlowRtl End With End Sub

الحل هو هو جعل الاماكن المطلوب الكتابة فيها عبارة عن مربعات نص و بالتالي لا تخضع لحماية عند اختيار Tools Protect Documents Comments و لكن ليس مربعات النص العادية و لكن تلك التي توضع فى وضع تصميم الفيجوال بيزيك اختار اظهار مجموعة ايقونات الفيجوال من Toolbars Customize بالنقر علي شريط الأدوات ثم اختيار وضع التصميم بالضغط علي المربع الازرق ثم اختيار ال ToolBox و ووضع مربع نص و كل ذلك طبعا و الملف غير محمي ثم نختار Tools Protect Documents Comments فيتم حماية كل الملف ما عدا مربعات النص التي تم وضعها