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

لمن يهمه الأمر تدوير صورة بمقدار قيمة معينة من الدرجات (90 أو180 أو270) DDChangImage Angle.rar

تم حل المشكلة شكرا اخ @محمد هشام. بارك الله فيك وزادك من فضله

لا افهم مادا تقصد لاكن طلبك كان في في تحديد اخر رقم ضمن المسلسل وهو على ملفك الرقم 78 وهدا ما ينفده الكود شيت الصف السادس ترم ثان.pdf

اختلاف تنسيق التاريخ .... انظر لنفس تاريخ التشغيل4

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

تم الاستيراد ........................ تم مسح المرفقات لأن بها مواد حساسة .....................

تمام اشتغل كان لازم اغير مسار الاكسيل جزاكم الله خيرا

توصل بالسلامة ان شاء الله

تكرم عينك اخوي @عبد اللطيف سلوم ، ولكن أمهلني حالما أصل البيت إن شاء الله ،

أنت تعلم أنك لن تحصل على إجابة دون النظر الى المشكلة كملف مرفق ،، إذا كانت المعلومات حساسة جداً لهذه الدرجة ، قم على الأقل بإنشاء نسخة أخرى ذات سجلات وهمية أو عشوائية كالأسماء أو ارقام الهاتف ( إن وجد ) . حينها أعتقد انك ستجد الحلول المناسبة أخي @عبد اللطيف سلوم 🤗

تم الإنتهاء من الفكرة ولله الحمد ,, وأرجو التكرم بتجربة الفكرة وإخباري بالنتيجة أو رأيكم .. الكود الأول للزر المسؤول عن طلب إدخال القيمة Private Sub Btn_Job_Click() Dim userInput As String Dim numericValue As Double Do userInput = InputBox("الرجاء إدخال القيمة رقمية", "إدخال قيمة") If userInput = "" Then Exit Sub Else DisplayQiblaDirection userInput End If If IsNumeric(userInput) Then numericValue = CDbl(userInput) Exit Do Else MsgBox "الرجاء إدخال قيمة رقمية فقط", vbExclamation, "قيمة غير رقمية" End If Loop End Sub الدالة التي من خلالها تم حل المشكلة وهي عرض الصورة التي تدل على الزاوية أو القيمة التي تم إدخالها في الرسالة . مع العلم أن كل صورة تمثل 6 درجات Private Sub DisplayQiblaDirection(ByVal userInput As String) Dim secValue As Integer Dim Rx As Integer Dim ctrl As Control Dim numericValue As Double If IsNumeric(userInput) Then numericValue = CDbl(userInput) Else Exit Sub End If Rx = Abs(numericValue) secValue = Abs(Round(numericValue / 6, 0)) If numericValue < 0 Then secValue = (360 - Rx) \ 6 End If For Each ctrl In Controls If Left(ctrl.Name, 1) = "s" Then If Right(ctrl.Name, Len(ctrl.Name) - 1) = secValue Then Me(ctrl.Name).Visible = True Else Me(ctrl.Name).Visible = False End If End If Next End Sub Test Directions.zip

Sub ImportWordTablesArray() Dim tables() As Variant Dim WordApp As Object, WordDoc As Object Dim arrFile As Variant, Filename As Variant Dim Table As Integer, iCol As Integer Dim iRow As Long, Cpt As Long, Counter As Long Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("word") Dim ar(1 To 7) Dim c As Integer Dim cnt As Integer cnt = LBound(ar()) ' قم بتعديل عرض الاعمدة بما يناسبك ar(1) = 10: ar(4) = 28: ar(7) = 85: ar(5) = 28: ar(6) = 35: ar(2) = 14: ar(3) = 68 On Error Resume Next arrFile = Application.GetOpenFilename("ملف وورد (*.doc; *.docx),*.doc;*.docx", 2, _ "اظافة الملف", , True) If Not IsArray(arrFile) Then Exit Sub Application.ScreenUpdating = False Set WordApp = CreateObject("Word.Application") WordApp.Visible = False WS.Cells.Clear For Each Filename In arrFile Set WordDoc = WordApp.Documents.Open(Filename, ReadOnly:=True) With WordDoc Table = WordDoc.tables.Count If Table = 0 Then MsgBox WordDoc.Name & "لا يحتوي على جداول", vbExclamation, "استيراد" End If tables = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, _ 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20) '<- '<- ارقام الصفحات For Counter = LBound(tables) To UBound(tables) With .tables(tables(Counter)) For iRow = 0 To .Rows.Count For iCol = 0 To .Columns.Count Cells(Cpt, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text) Next iCol Cpt = Cpt + 1 Next iRow End With Cpt = Cpt + 1 Next Counter .Close False End With Next Filename WordApp.Quit Set WordDoc = Nothing Set WordApp = Nothing lr = WS.Columns("A:G").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1 For Each j In WS.Range("G2:G" & lr) WS.Hyperlinks.Add j, j Next j WS.Rows(1).Interior.ColorIndex = 45 For cnt = LBound(ar()) To UBound(ar()) Columns(cnt).ColumnWidth = ar(cnt) Next cnt Set rngCell = WS.Range("A1 :g" & lr) For Each k In rngCell.Rows If WorksheetFunction.CountA(k) > 0 Then k.Borders.ColorIndex = 5 'c.Borders.LineStyle = xlContinuous Next With WS.Range("a2:a" & WS.Cells(Rows.Count, "b").End(xlUp).Row) .Value = Evaluate("ROW(" & .Address & ")-1") End With End Sub https://streamable.com/xdlk5v TEST WORD.rar

استاذ @Moosak شكراً لمرورك ............ نعم لذلك أنا اخترت الصورة وخزنتها بمجلد خاص لعدم تغيير الصورة الأصلية .

شكرا لك أستاذ خليفة ، طبعا الكود يقوم بتدوير الصورة الأصلية من مصدرها (للعلم) 🙂

اعرض الملف حساب التوزيع الطبيعي بناء على معامل Z هذا الملف يحتوي ثلاثة أوراق عمل الأولي تجوي معادلات حساب الاحتمالات ( المساحة تحت المنحنى الطبيعي المعياري) بناء على معامل Z والثانية تحوي حساب كامل جدول التوزيع الاحتمالي بالمعادلات و الثالث مثال لحساب احتمال استكمال نشاط وحيد فى زمن محدد بناء على الزمن المتفائل والمتشائم والاكثر احتمالا لهذا النشاط ، مع ملاحظة أنه فى حال الحساب لاكثر من نشط ييجب مراعاة المسار الحرج و الحساب لكامل المسار ، و في هذه الحالية لا يتم جمع الانحرافات المعيارية للمسار الحرج و انما يتم جمع التباين و جساب الانحراف المعياري للمسار منه. حيث ان الانحراف المعياري للمسار = الجزر التربيعي لمجموع تباين الانشطة على المسار صاحب الملف محمد طاهر عرفه تمت الاضافه 01 ماي, 2024 الاقسام قسم الإكسيل

Sub PDF_شيت_ترم_2() Dim FSO As Object Dim S(1) As String Dim sNewFilePath As String Dim Row As Long Set FSO = CreateObject("Scripting.FileSystemObject") S(0) = ThisWorkbook.FullName If FSO.FileExists(S(0)) Then S(1) = FSO.GetExtensionName(S(0)) If S(1) <> "" Then S(1) = "." & S(1) Set WS = ActiveSheet lastRow = WS.Columns("A:A").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row With WS.PageSetup .PrintArea = "$A$3:$CH$" & lastRow End With sNewFilePath = ThisWorkbook.Path & "\شيت الصف السادس ترم ثان.pdf" WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNewFilePath, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End If Else MsgBox "لم يتم حفظ الملف ..يوجد خطأ ما " End If Sheets("شيت2").Activate Set FSO = Nothing ' mainy m = MsgBox("تم تصدير الشيت خارج الشيت بإسم شيت الصف السادس ترم ثان" & vbNewLine _ & "هذا الملف موجود فى نفس مكان برنامج الكنترول شيت", _ vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal + vbMsgBoxRight, _ "تم تصدير شيت صف السادس ترم 2 بصيغة pdf.") End Sub

اذاً الحل يسير وبسيط أخي ، انشئ ملف اكسيس جديد ( قاعدة بيانات جديدة فارغة ) ، ثم اعمل استيراد لجميع الجداول والنماذج .... الخ ؛ الى القاعدة الجديدة الفارغة وأن شاء الله تنحل مشكلتك

وهذه مغامرتي وتجربتي بعد العديد من المحاولات 😊 قابلة للتطوير كما تحب 🤗 ‏‏Meter -Moosak _ Final.accdb

قاعده بيانات للتجارب-1 (2).rar kkhalifa1960 اخى الفاصل ..متشكر جدا وكتر الف خيرك ..ربنا يجازيك خير ويكتر من امثالك..الكود اللى انت عامله مش هوا اللى انا عايزه ولكن نغعنى جداااااااا ..انا عدلت عليه وعملت اللى انا عايزه وحطيت الكود على الفورم عند الفنح وكمان نسخته على check box علشان اشغله ......متشكر جدا لردك ولاهتمامك ..انا نزلتها هنا علشان لو حد عايز يستفيد منها قاعده بيانات للتجارب الحل النهائى.rar

جرب هل هدا ما تقصده smr (1)v2.xlsm

مع تقديري لمشرف قسم الوورد العزيز تومي محمد الحكمة تقول : ( ما لا يمكن اليوم يمكن غدا وما لا يمكن عندي يمكن عند غيري ) فيمكن اضافة رموز جديدة الى مربع الحوار رمز ، كما يمكن حذف رموز موجودة ، لان هذه الرموز عبارة عن ملفات خطوط عند الاطلاع ومراجعة ملفات الخطوط في مجلد Font يتضح كل شيء