أ / محمد صالح

ربما لا يوجد في ملفة ورقة عمل باسم برمجي sheet2

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

يمكنك وضع جميع ملفات الاكسل المطلوب تحويلها في مجلد باسم xls بنفس مسار الملف الذي به هذا الكود وإنشاء مجلد باسم csv بنفس مسار الملف الذي به هذا الكود واستدعاء الاجراء Mas_Xls2Csv Sub Mas_Xls2Csv() Dim xObjWB As Workbook Dim xStrEFPath As String Dim xStrEFFile As String Dim xStrSPath As String Dim xStrCSVFName As String Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual xStrEFPath = ThisWorkbook.Path & "\xls\" xStrSPath = ThisWorkbook.Path & "\csv\" xStrEFFile = Dir(xStrEFPath & "*.xls*") Do While xStrEFFile <> "" Set xObjWB = Workbooks.Open(Filename:=xStrEFPath & xStrEFFile) xStrCSVFName = xStrSPath & Left(xStrEFFile, InStr(1, xStrEFFile, ".") - 1) & ".csv" xObjWB.SaveAs Filename:=xStrCSVFName, FileFormat:=xlCSVUTF8 xObjWB.Close savechanges:=False xStrEFFile = Dir Loop Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "Done by mr-mas.com" End Sub بالتوفيق

يمكن وضع الرقم الثاني في h4 واستعمال هذه المعادلة =SUMIF($C:$C,G4,$D:$D)+SUMIF($C:$C,H4,$D:$D) أو هذه =SUMPRODUCT(SUMIF(C:C, G4:H4, D:D)) بالتوفيق

جزاكم الله خيرا جميعا ويمكن اختصار المعادلة هكذا =IF(B2="Omani",IF(C2>=3000,3000,C2)*0.07,0) بالتوفيق

بارك الله لك وأود أن أضيف شرطا أن يكون تطبيق واتس آب مثبتا في جهاز الكمبيوتر أو الموبايل بالتوفيق

أعتقد أنه لا يوجد حدث في الاكسل يسمى عند ادخال كلمة مرور خاطئة في vbe كما أن حذف الموديولات يتطلب إعدادات خاصة في الماكرو trust access to the vba project object model ولا ينصح باستعمال هذه الخاصية إلا لمن يعرف التعامل معها وليس للعملاء مثلا بالتوفيق

جميعا بإذن الله

هذه المعادلة في C2 =SUM(B2,A2/100) تفي بالغرض بالتوفيق

يمكنك استعمال هذه المعادلة في الخلية B2 =IF(A2="","لايوجد رقم","الرقم "&IF(COUNTIF(C:C,A2)>0,"","غير ")&"موجود") وهذه في D2 =IF(C2="","لايوجد رقم","الرقم "&IF(COUNTIF(A:A,C2)>0,"","غير ")&"موجود") بالتوفيق

جزاكم الله خير الجزاء بالتوفيق

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

تحتاج فقط إلى ضبط عرض الأعمدة سواء في خصائص العنصر أو بالكود التالي Private Sub UserForm_Activate() CM_ListFind.ColumnWidths = "40,80,200,110,80,80,80" End Sub مع تحريك العناوين الموجودة فوق القائمة ويفضل جعل محاذاة القائمة يمين وليس توسيط بالتوفيق

أعتقد لابد من وضع نسبة من الاثنين حتى يمكن الحصول على الثانية لأن خلية النسبة داخلة في معادلة العمود I التي يتم حساب الخلية G11 بناء على مجموع العمود i مع وضع g11 على شكل رقم وليس معادلة وهذا جهدي المتواضع فيما يخص هذه الطريقة وقد أوضحت فيها: * حساب مجموع العمود i في الخلية (i11) في حالة معرفة G11 * حساب النسبة في حالة معرفة القيمة المقابلة في i بالتوفيق ves.xlsx

يمكنك استعمال هذه المعادلة في الخلية m6 وسحب المعادلة لأسفل =IF(L6>6,0,IF(L6>5,0.5,IF(L6>4,0.4,IF(L6>3,0.3,1))))*K6 مع مراعاة الفاصلة أو الفاصلة المنقوطة حسب اعدادات جهازك بالتوفيق

الحمد لله الذي،وفقنا لهذا

إن كان ناتج هذه المعادلة مرجع نطاق مثل A1 فيمكن استعمال هذه المعادلة =HYPERLINK("#"&CELL("address",INDIRECT("data!"&IFERROR(VLOOKUP(H11;DATA!A3:AQ252;43;FALSE);VALUE(("0"))))),"click here") ويمكن تغيير نص الرابط click here إلى أي نص مرغوب بالتوفيق

جميعا بإذن الله

يمكنك استعمال هذا الكود Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyDelete, _ vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab If KeyAscii = 46 Then If InStr(1, TextBox1.Text, ".") Then KeyAscii = 0 Case Else KeyAscii = 0 End Select End Sub بالتوفيق

جميعا بإذن الله

يتم ذلك عن طريق تحديد الأعمدة المراد تجميعها ثم تبويب بيانات data ثم outline مخطط خارجي تقريبا ثم group تجميع بالتوفيق

حسب فهمي للمطلوب يتم تنفيذ أمر الطباعة أولا ActiveSheet.PrintOut ثم سطر التصدير إلى. Pdf في نفس مسار ملف الاكسل باسم FileName.pdf الذي يمكن تغييره ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "/" & "FileName.pdf", , , False بالتوفيق

حسب فهمي للمطلوب فلا تحتاج لكتابة today في خلية وإنما تحتاج لكتابة تاريخ البداية مثلا A1 وتاريخ النهاية B1 ونستعمل هذه المعادلة =IF(AND(TODAY()>A1,TODAY()<B1),"yes","no") مع تغيير yes و no إلى النص المراد في الحالتين بالتوفيق

الكود ينفذ المطلوب حذف الصف كاملا EntireRow.Delete لخلايا العمود c من الصف الأول إلى آخر صف مكتوب فيه Cells(Rows.Count, 3).End(3).Row بشرط أن تكون الخلايا فارغة SpecialCells(4) بالتوفيق

الشكر لله الذي وفقنا لهذا وهذا رابط لشرح دالتي index & match في البحث