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

مبارك عليكم الترقية المستحقة تهانينا الحارة 👍💥🌺💐

نبارك لأخينا الكريم محمد هشام هذه الترقية المستحقة عن جدارة تهانينا الحارة 💥💥🌺💐 congratulations 💐🌺💥💥

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

الف الف مبروك

الف مبروك 💐

مبروك الأستاذ Mohamed Hicham إنضمامك لعائلة الخبراء ,أسأل الله لك التوفيق والنجاح دائما ..وأعانك الله على هذه المسئولية الجديدة وسدد الله خطاك ..عن حق وجدارة بارك الله فيك وزادك الله من فضله

الف مليون مبروك

جزاك الله خير على الدعاء اخي قاضي واحيانا عند استخدام تلوين الحدود لحدث ما قد نحتاج الى اضهار هذه الحدود بشكل اكبر لتكون اوضح ولعمل ذلك ممكن نستخدم مع الامر السابق الكود التالي Me.tx2.BorderWidth = 1 وهذا الامر له عدة قيم 0 الاعداد الافتراضي 1 الى 6 لزيادة حجم الحدود موفق اخي قاضي

لتلوين الحدود لمربع النص Me.tx2.BorderColor = RGB(53, 30, 236) وممكن هكذا ⬇️ والاول افضل Me.tx2.BorderColor = 255 تحياتي

وعليكم السلام ورحمه الله وبركاته عن طريق تجربه البرامج التي تصنع pdf لدي هذه هي النتائج Microsoft Print to pdf الطباعه عن طريق Microsoft Print to pdf لا يوجد بها تقطيع Adobe pdf.pdf الطباعه عن طريق Adobe pdf لا يوجد بها تقطيع ولكن تاتى ببعض الكلمات باللون الاسود dopdf.pdf الطباعه عن طريق Do pdf هي التى يوجد بها تقطيع

هدية مني لمدارس العراق ديناميكي لا يحتاج لتدخل مبرمج أو خبير إكسل لتكييفه مع مراحل الدراسة المختلفة. عن طريق صفحة التفاصيل: - يقبل إضافة أو حذف مواد (عدد المواد). - يقبل تبديل مسميات المواد لصفحتي المسودة والقائمة. - يقبل تبديل درجة النجاح لكل المواد منفردة أي كل مادة على حدة. - يقبل تبديل درجة القرار. - يقبل تبديل درجة النجاح. - يقبل تبديل عدد مواد الإكمال الأقصى. توزيع القرار لمدارس العراق_01.xlsm

انتبه من فضلك هاوي اكسل فالكود يعمل بكل كفاءة وشوف بنفسك فضمون الرسالة التى تظهر لك ان هذه مشكلة عندك انت ويجب عليك اصلاحها بنفسك ويكمن حل مشكلتك بعمل كليك يمين على ملف الإكسيل قبل فتحه ثم الضغط على Properties (الخصائص) ثم بعد ذلك تفعيل واختيار Unblock بمعنى وضع علامة صح داخل مربعها وسيعمل الملف معك بكل كفاءة ويسر ورقة عمل Microsoft Excel جديد (1).xlsm

الف مبروك

السلام عليكم ورحمة الله تعالى وبركاته اليك حل اخر بالاكواد Sub Count_cells_if() Dim MH As Variant Dim ws As Worksheet Set ws = Worksheets("sh1") Range("A10:D10").ClearContents On Error Resume Next MH = 0: MH = Application.WorksheetFunction.CountIf(ws.Range("a" & Application.WorksheetFunction.Match(Range("f3"), _ Range("a1:a9"), 0) & ":a9"), "<=" & ws.Range("f3")) If MH <> 0 Then ws.Range("a10") = MH '''''''''''''''''''''''''''''''''''''''' MH = 0: MH = Application.WorksheetFunction.CountIf(ws.Range("B" & Application.WorksheetFunction.Match(Range("f3"), _ Range("B1:B9"), 0) & ":B9"), "<=" & ws.Range("f3")) If MH <> 0 Then ws.Range("B10") = MH '''''''''''''''''''''''''''''''''''''' MH = 0: MH = Application.WorksheetFunction.CountIf(ws.Range("C" & Application.WorksheetFunction.Match(Range("f3"), _ Range("C1:C9"), 0) & ":C9"), "<=" & ws.Range("f3")) If MH <> 0 Then ws.Range("C10") = MH ''''''''''''''''''''''''''''''''''''''''' MH = 0: MH = Application.WorksheetFunction.CountIf(ws.Range("D" & Application.WorksheetFunction.Match(Range("f3"), _ Range("D1:D9"), 0) & ":D9"), "<=" & ws.Range("f3")) If MH <> 0 Then ws.Range("D10") = MH On Error GoTo 0 End Sub ورقة عمل Microsoft Excel جديد (1).xlsm

السلام عليكم و رحمة الله استخدم المعادلة التالية =COUNTIF(OFFSET($A$1;MATCH($F$3;$A$1:$A$9;0)+1;0;9;1);"<="&$F$3)

وعليكم السلام ورحمة الله وبركاته استبدل cells ب range

بارك الله فيك استاذ AbuuAhmed وجعلك الله دائماً وأبداً زخراً لكل المحتاجين وجعل الله هذا العمل الممتاز فى ميزان حسناتكم وزادك الله من فضله

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

تفضل اخي Private Sub CommandButton1_Click() Dim lr As Integer Dim ws As Worksheet Set ws = Sheet2 With ws lr = .Cells(Rows.Count, 3).End(xlUp).Row .Range("h" & lr + 1).Value = Me.TextBox1.Value .Range("f" & lr + 1).Value = Me.TextBox2.Value .Range("c" & lr + 1).Value = Me.TextBox3.Value End With Me.TextBox1.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox1.SetFocus End Sub 1محل.xlsm

السلام عليكم و رحمة الله ضع هذا الكود فى حدث الورقة data Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$3" Then Exit Sub Sheets(Target.Text).Activate End Sub

وعليكم السلام ورحمة الله وبركاته أخي عبدالله 🙂 لو صورت الجزئية التي يقف عليها المؤشر بالأصفر عند الضغط على ال Debug وعلى العموم يمكنك ببساطة تغيير الكود .. هناك الكثير من الأكواد التي تؤدي نفس العمل .. 🙂 هذا الكود الذي أستخدمه أنا ويعمل معي جيد ، الكود يأخذ نسخة لقاعدة البيانات كلها إذا كانت غير مقسمة . وإذا كانت مقسمة فإنه ينسخ ملف الجداول فقط . وفي كلا الحالتين الكود ينشئ النسخة في مجلد اسمه Backup بجانب البرنامج : Public Sub Backupme() On Error GoTo MyErr Dim OldFile, NewFile, CopyMyDB, wheretoBackup, BackupFolder, DBName As String If IsNull(DLookup("Database", "MSysObjects", "Type=6")) Then OldFile = CurrentProject.FullName wheretoBackup = CurrentProject.Path Else OldFile = DLookup("Database", "MSysObjects", "Type=6") wheretoBackup = Left(OldFile, InStrRev(OldFile, "\")) End If BackupFolder = wheretoBackup & "\Backup" On Error Resume Next If Len(Dir(BackupFolder)) = 0 Then MkDir BackupFolder Else End If On Error GoTo MyErr DBName = Left(CurrentProject.Name, InStrRev(CurrentProject.Name, ".") - 1) NewFile = wheretoBackup & "\Backup\" & DBName & "-Backup-" & Format(Date, "dd-mm-yyyy") & "-" & Format(Now(), "Hh-Nn-ss-AMPM.") & Right(OldFile, 5) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 MsgBox "Backup……..Done" & vbNewLine & vbNewLine & "Saved in :" & vbNewLine & NewFile, , " " MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If End Sub '=======================================(كود آخر) Public Function CreateBackup() As Boolean Dim Source As String Dim Target As String Dim a As Integer Dim objFSO As Object Dim Path As String Path = CurrentProject.Path 'get location of current folder Source = CurrentDb.Name Target = Path & "\BackupDB " Target = Target & Format(Now(), "mm-dd") & ".accdb" ' create the backup a = 0 Set objFSO = CreateObject("Scripting.FileSystemObject") a = objFSO.CopyFile(Source, Target, True) Set objFSO = Nothing End Function وهذا الكود للمهندس محمد عصام :

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

وعليكم السلام ورحمه الله وبركاته اخى @talal baghdadi ضع هذه المعادله في الخليه E14 واسحب لاسفل قدر ما تحتاج =Ameen|AcnBal!'AccCode=&INDIRECT("D" &ROW(),StartDate="1-1-2022",EndDate="30-10-2022",ShowUnPostedEnt="1"'

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

تفضل وشكراً واى خدمة وده بطريقة أخرى

وعليكم السلام ورحمة الله تعالى وبركاته جرب اخي Private Sub CommandButton1_Click() Dim lr As Integer Dim ws As Worksheet Set ws = Sheet4 With ws lr = .Cells(Rows.Count, 1).End(xlUp).Row .Range("a" & lr + 1).Value = Me.TextBox2.Value .Range("b" & lr + 1).Value = Me.TextBox3.Value .Range("c" & lr + 1).Value = Me.TextBox4.Value .Range("d" & lr + 1).Value = Me.TextBox5.Value .Range("e" & lr + 1).Value = Me.TextBox6.Value End With Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox2.SetFocus End Sub

وعليكم السلام ورحمة الله تعالى وبركاته اخي لم تحدد مكان وضع صورة البطاقة !!!!!...اما بالنسبة للصورة الشخصية يمكنك استخدام المعادلة التالية : =INDEX('ادخال البيانات'!$B$8:$C$300;EQUIV('فورم البيانات'!$B$10;'ادخال البيانات'!$C$8:$C$300;0);1) تجريبى.xls

نصيحة المنتدى هنا منتدى تعليمى واذا اردت المساعدة فارفق مرفق (يوجد قسم خاص للبرامج الجاهزة ـ ادخل عليها) يصعب على الاخوان هنا وعليا انا شخصيا ان نفى بالحل دون مرفق ضع مرفق بالجداول وبعض النماذج تجد الاخوان يتسابقون للمساعدة جزاك الله كل خير

السلام عليكم ورحمة الله تعالى وبركاته ..تفضل اخي صراحة لم تواجهني اي مشكلة !!!!! Classeur1.pdf

السلام عليكم استاذ husseinharby تفضل التعديل حسب فهمي لطلبك Database10.rar

وعليكم السلام ..جرب هذا كيفية نقل البيانات من العمود (الأعمدة) إلى الصف (الصفوف) أو العكس في Excel؟

الف شكر لك اخي وأستاذى الكريم ابراهيم .. نقلت المعادلة على ملف اخر لم تعمل الف شكر لك اخي الغالي محمد هشام ..لم يعمل الماكرو ..مع اني مكنت كافة وحدات الماكرو