أ / محمد صالح

يفضل إرفاق ملفك لاكتشاف موضع الخطأ الذي يظهر هذه الرسالة

ربما يفيدك هذه المجهودات السابقة جزاهم الله كل خير ملفات الخطوط وملفات القرآن وورد واكسل و txt & sql والكثير من الامتدادات ولجميع القراءات منصة مطوري برمجيات القرآن الكريم – مجمع الملك فهد لطباعة المصحف الشريف (qurancomplex.gov.sa) بالتوفيق للجميع

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

إذا كنت تستخدم إصدار أوفيس حديث يمكنك استعمال معادلة filter =FILTER($A$1:$E$1000,$B$1:$B$1000=$J$1,"") حيث J1 الخلية التي بها التاريخ المطلوب بالتوفيق للجميع

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

عليكم السلام ورحمة الله وبركاته حتى يعمل الكود تلقائيا يجب ربطه بحدث مثل تغيير التحديد أو تغيير محتوى الشيت وهذا الكود في حدث تغيير محتوى الشيت Private Sub Worksheet_Change(ByVal Target As Range) Rows("1:16").EntireRow.Hidden = 0 For r = 1 To 16 If Range("b" & r).Value = 0 Then Rows(r & ":" & r).EntireRow.Hidden = True End If Next r End Sub بالتوفيق للجميع

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

بارك الله فيكم جميعا لتغيير نص أزرار رسالة msgbox يمكن استعمال هذا الموديول يوجد مثالين للاستخدام #If VBA7 Then Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" _ () As Long Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _ (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long Private Declare PtrSafe Function CallNextHookEx Lib "user32" _ (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _ (ByVal hHook As LongPtr) As Long Private hHook As LongPtr ' handle to the Hook procedure (global variable) #Else Private Declare Function GetCurrentThreadId Lib "kernel32" _ () As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long Private Declare Function CallNextHookEx Lib "user32" _ (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" _ (ByVal hHook As Long) As Long Private hHook As Long ' handle to the Hook procedure (global variable) #End If Private Const WH_CBT = 5 ' hook type Private Const HCBT_ACTIVATE = 5 ' activate window Private sMsgBoxDefaultLabel(1 To 7) As String Private sMsgBoxCustomLabel(1 To 7) As String Private bMsgBoxCustomInit As Boolean Private Sub MsgBoxCustom_Init() Dim nID As Integer Dim vA As Variant ' base 0 array populated by Array function (must be Variant) vA = VBA.Array(vbNullString, "OK", "Cancel", "Abort", "Retry", "Ignore", "Yes", "No") For nID = 1 To 7 sMsgBoxDefaultLabel(nID) = vA(nID) sMsgBoxCustomLabel(nID) = sMsgBoxDefaultLabel(nID) Next nID bMsgBoxCustomInit = True End Sub Public Sub MsgBoxCustom_Set(ByVal nID As Integer, Optional ByVal vLabel As Variant) If nID = 0 Then Call MsgBoxCustom_Init If nID < 1 Or nID > 7 Then Exit Sub If Not bMsgBoxCustomInit Then Call MsgBoxCustom_Init If IsMissing(vLabel) Then sMsgBoxCustomLabel(nID) = sMsgBoxDefaultLabel(nID) Else sMsgBoxCustomLabel(nID) = CStr(vLabel) End If End Sub Public Sub MsgBoxCustom_Reset(ByVal nID As Integer) Call MsgBoxCustom_Set(nID) End Sub #If VBA7 Then Private Function MsgBoxCustom_Proc(ByVal lMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr #Else Private Function MsgBoxCustom_Proc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long #End If Dim nID As Integer If lMsg = HCBT_ACTIVATE And bMsgBoxCustomInit Then For nID = 1 To 7 SetDlgItemText wParam, nID, sMsgBoxCustomLabel(nID) Next nID End If MsgBoxCustom_Proc = CallNextHookEx(hHook, lMsg, wParam, lParam) End Function Public Sub MsgBoxCustom( _ ByRef vID As Variant, _ ByVal sPrompt As String, _ Optional ByVal vButtons As Variant = 0, _ Optional ByVal vTitle As Variant, _ Optional ByVal vHelpfile As Variant, _ Optional ByVal vContext As Variant = 0) hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxCustom_Proc, 0, GetCurrentThreadId) If IsMissing(vHelpfile) And IsMissing(vTitle) Then vID = MsgBox(sPrompt, vButtons) ElseIf IsMissing(vHelpfile) Then vID = MsgBox(sPrompt, vButtons, vTitle) ElseIf IsMissing(vTitle) Then vID = MsgBox(sPrompt, vButtons, , vHelpfile, vContext) Else vID = MsgBox(sPrompt, vButtons, vTitle, vHelpfile, vContext) End If If hHook <> 0 Then UnhookWindowsHookEx hHook End Sub Sub Custom_MsgBox_1() MsgBoxCustom_Set vbOK, "Open" MsgBoxCustom_Set vbCancel, "Close" MsgBoxCustom ans, "Click a button.", vbOKCancel End Sub Sub Custom_MsgBox_2() MsgBoxCustom_Set vbYes, "Start" MsgBoxCustom_Set vbNo, "Stop" MsgBoxCustom ans, "Click a button.", (vbYesNo + vbQuestion) End Sub بالتوفيق للجميع

فعلا مثل هذا المطلوب يحتاج إلى تدخل جراحي (كود vba)

عليكم السلام ورحمة الله وبركاته يمكنك استعمال هذه المعادلة المختصرة على اعتبار أن الرقم موجود في الخلية A2 =MID(A2,5,LEN(A2)-10) بالتوفيق

ربما يفيدك هذا الموقع https://www.arabic-names.com/arabictoenglish

أنا شخصيا في مثل هذه الحالة أفتح الصورة في مستعرض الويندوز الافتراضي بالأمر shell وبالنسبة لطلبك في الضغط على الزر يمكنك استعمال مثل هذا الكود Private Sub CommandButton1_Click() Call Add_Image End Sub وفي موديول جديد نستعمل هذا الكود Sub Add_Image() Set Img = UserForm2.Controls.Add("Forms.Image.1") With Img .Picture = LoadPicture("مسار الصورة") .PictureSizeMode = fmPictureSizeModeStretch .Left = 10 .Top = 10 End With End Sub بالتوفيق

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

كتابة اسم الشيت بها احتمالات للخطأ الأفضل اختيار الاسم من قائمة بأسماء الشيتات ساعتها يمكنك استخدام أمر فتح الشيت Sheets(Range("a1").Text).Activate بالتوفيق

في موديول جديد ويمكن استخدامها في التقرير أو الاستعلام أو في النموذج بالطريقة المذكورة في المشاركة السابقة بالتوفيق للجميع

يمكن بطرق كثيرة اسهلها البحث والاستبدال CTRL+H ثم تكتب في مربع البحث العملة ومربع الاستبدال يترك فارغا ثم استبدال الكل replace all بالتوفيق

يمكنك البدء في التصميم بعدها تعرض المشكلات التي تواجهها في البرنامج ساعتها تجد الكثير من الزملاء يساعد

مادمت حضرتك صاحب الملف ونسيت كلمة المرور يمكنك استخدام برامج لهذا الغرض مثل AOPR Advanced office password recovery بالتوفيق

لعرض آخر 20 ضف يمكنك تغيير هذا السطر في الاجراء showdata For frw = 4 To last إلى For frw = last - 19 To last ولخذف الصف المطلوب Private Sub CommandButton1_Click() If MsgBox("Are you sure you want to delete this item?", vbYesNo, "Confirm Delete") = vbYes Then Rows(ListView1.SelectedItem.ListSubItems(1).Text + 3).EntireRow.Delete showdata End If MsgBox "Done by mr-mas.com" End Sub بالتوفيق

يمكنك استخدام هذه المعادلة لاشتخراج اليوم =VALUE(TEXT($A$2,"[$-,117]B2dd;@")) وهذه لاستخراج الشهر =VALUE(TEXT($A$2,"[$-,117]B2mm;@")) وهذه لاستخراج العام =VALUE(TEXT($A$2,"[$-,117]B2yyyy;@")) وهذا ملفك بعد وضع المعادلات بالتوفيق استخراج اليوم والشهر والسنة من التاريخ الهجري.xlsx

وبدون عمود مساعد يمكنك استعمال هذه المعادلة في الخلية L25 =IF(L24-L25<0,100,0)+L24-L25 وهذه في M25 =IF(L24-L25<0,-1,0)+M24-M25 بالتوفيق

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

ينطبق على الأول والثاني اخي الكريم هي مجرد استعمال لقاعدة IF في سطر واحد لذلك تكتب IIF خاصية الإخفاء للصفوف كذا هي نتيجة الشرط true أو false والشرط هو V1 = 28 وفقنا الله جميعا لكل ما يحبه ويرضاه

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

تقريبا قام أحد المستخدمين بحذف أعمدة حركت خلية العدد الكلي للأسماء من Z2 إلى U2 يمكنك تغيير هذا السطر في الكود Loop While ActiveCell.Value <= Range("Z2").Value إلى Loop While ActiveCell.Value <= Range("U2").Value بالتوفيق