أ / محمد صالح

أعتقد مطلوبك موجود بالفعل في شيت data بمجرد أن تكتب اسم العميل تتم الفلترة عليه وهذا الذي تريده في صفحة كشف حساب عميل بعد اختيار العميل من القائمة تتم جلب سجلاته وبدون الفلترة في صفحة data تحصل على كشف بأرصدة كل العملاء ملحوظة: من قام بما قمت به يسهل عليه وضع معادلة تصفية بالمعادلات بالتوفيق

أخي الكريم الحل المقدم من أخينا @AbuuAhmed صحيح جدا ولكن ربما لم يتم التنفيذ بطريقة صحيحة الطريقة الصحيحة أن تضع السطر الخاص بتعطيل زر esc أولا ثم أكواد الاجراء الخاص بك وفي نهاية تضع كود تمكين زر esc Sub yoursubname() Application.EnableCancelKey = xlDisabled ' ضع هنا الكود الذي تريد تنفيذه Application.EnableCancelKey = xlInterrupt End Sub بالتوفيق

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

يمكنك البحث في المنتدى عن cdo و gmail ستجد الطريقة ويمكنك تعديلها بما يتناسب مع احتياجات حضرتك بالتوفيق للجميع

يمكنك وضع تاريخ نهاية التقييم في العمود E والتقييم في العمود F واستعمال هذه المعادلة في العمود C إلى =IF(TODAY()<=E2,F2,1) بالتوفيق

يمكنك تعديل الكود المستعمل في الملف إلى هذا وتم إضافة متغير لتحديد الصف الأخير من العمود A Option Explicit Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Boolean Sub Export_Range_As_Picture() Dim Ws As Worksheet, StrToFolder2 As String, lr As Long Dim oRng As Range, sPath As String, oChart As ChartObject Set Ws = ActiveSheet Application.ScreenUpdating = False StrToFolder2 = "D:\pic\" MakeSureDirectoryPathExists StrToFolder2 sPath = StrToFolder2 & Ws.Range("a1").Value & "." & "jpg" lr = Cells(Rows.Count, 1).End(xlUp).Row Set oRng = Ws.Range("A2:E" & lr) oRng.CopyPicture xlScreen, xlPicture Set oChart = Ws.ChartObjects.Add(Left:=0, Top:=0, Width:=oRng.Width * 1, Height:=oRng.Height * 1) With oChart .Activate .Chart.Paste .Chart.Export Filename:=sPath .Delete End With Application.ScreenUpdating = True End Sub بالتوفيق

أخي الكريم صاحب الاستفسار ما يظهر في شريط المعادلات هو قيمة الخلية الأصلية ويمكنك التحكم في طريقة عرضها من خلال تنسيق الخلايا format cells أما إذا كنت تريد أن يظهر في شريط المعادلات القيم بعد التقريب باستخدام معادلة مثلا =TRUNC(A1,0) فيجب نسخ بيانات النطاق بعد التقريب ثم لصقه كقيم paste as values مكان النطاق الأصلي بالتوفيق للجميع

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

ربما يفيدك هذه المجهودات السابقة جزاهم الله كل خير ملفات الخطوط وملفات القرآن وورد واكسل و 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 بالتوفيق