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

الان يمكن العمل العمل بكل بساطة Option Explicit Sub find_Studant_Data() On Error Resume Next Dim My_St: My_St = Sheets("Home").Cells(2, "L") Dim sh As Worksheet Dim r%, n%, SH_name$ Dim find_rg As Range Dim Adr$, col%: col = 2 Dim k% Dim arr_Even(1 To 13) Dim arr_Odd(1 To 12) Range("My_range") = vbNullString '========================================== arr_Even(1) = 6: arr_Even(2) = 8: arr_Even(3) = 10: arr_Even(4) = 12 arr_Even(5) = 14: arr_Even(6) = 16: arr_Even(7) = 20: arr_Even(8) = 22 arr_Even(9) = 18: arr_Even(10) = 24: arr_Even(11) = 26: arr_Even(12) = 28 arr_Even(13) = 30 For n = 1 To UBound(arr_Even) - 1 arr_Odd(n) = arr_Even(n) + 1 Next '============================= For n = 2 To Sheets.Count Set find_rg = Sheets(n).Range("B:B").Find(My_St, Lookat:=xlWhole) If Not find_rg Is Nothing Then r = find_rg.Row Adr = find_rg.Address Set sh = Sheets(n) With Sheets("Home") .Cells(2, "F") = Sheets(n).Name & ":" & Adr .Cells(4, "C") = sh.Range(Adr).Offset(, 2) .Cells(6, "C") = sh.Range(Adr).Offset(, 1) .Cells(4, "K") = sh.Range(Adr).Offset(, -1) .Cells(6, "K") = sh.Range(Adr) .Cells(2, "J") = sh.Range(Adr).Offset(, -1) .Cells(2, "K") = sh.Range(Adr).Offset(, 2) '===================================== For k = LBound(arr_Even) To UBound(arr_Even) .Cells(14, col) = sh.Range(Adr).Offset(, arr_Even(k)) col = col + 1 Next col = 2 For k = LBound(arr_Odd) To UBound(arr_Odd) .Cells(15, col) = sh.Range(Adr).Offset(, arr_Odd(k)) col = col + 1 Next '============================= End With Exit For End If Next If r = 0 Then MsgBox "Not Found" & Chr(10) & _ "The Number: " & My_St & " Does't Exists", 64, "Salim Tell You" Erase arr_Even: Erase arr_Odd End Sub الملف مرفق اFind_notes New_Edition.xlsm

حرب هذا الكود للبحث فن الاسم (يمكنك عمل مثله للبحث عن الرقم القومي) Option Explicit Sub find_St() Dim My_St$: My_St = Sheets("Home").Cells(2, "J") Dim sh As Worksheet Dim r%, n%, SH_name$ Dim find_rg As Range Dim Adr$, col%: col = 2 Dim k% Dim arr_even(1 To 13) Dim arr_Odd(1 To 12) Range("My_range") = vbNullString '========================================== arr_even(1) = 4: arr_even(2) = 6: arr_even(3) = 8: arr_even(4) = 10 arr_even(5) = 12: arr_even(6) = 14: arr_even(7) = 18: arr_even(8) = 20 arr_even(9) = 16: arr_even(10) = 22: arr_even(11) = 24: arr_even(12) = 26 arr_even(13) = 28 For n = 1 To UBound(arr_even) - 1 arr_Odd(n) = arr_even(n) + 1 Next '============================= For n = 2 To Sheets.Count Set find_rg = Sheets(n).Range("D:D").Find(My_St) If Not find_rg Is Nothing Then r = find_rg.Row Adr = find_rg.Address Set sh = Sheets(n) With Sheets("Home") .Cells(2, "F") = Sheets(n).Name & ":" & Adr .Cells(4, "C") = sh.Range(Adr) .Cells(6, "C") = sh.Range(Adr).Offset(, -1) .Cells(4, "K") = sh.Range(Adr).Offset(, -3) .Cells(6, "K") = sh.Range(Adr).Offset(, -2) '===================================== For k = LBound(arr_even) To UBound(arr_even) .Cells(14, col) = sh.Range(Adr).Offset(, arr_even(k)) col = col + 1 Next col = 2 For k = LBound(arr_Odd) To UBound(arr_Odd) .Cells(15, col) = sh.Range(Adr).Offset(, arr_Odd(k)) col = col + 1 Next '============================= End With Exit For End If Next If r = 0 Then MsgBox "Not Found": Exit Sub Erase arr_even: Erase arr_Odd End Sub الملف مرفق اFind_notes.xlsm

لكل عشاق الحديث في برمجة الأوفيس المتقدمة VBA يسعدني أن أقدم لكم شرح كود ترجمة جوجل 2019 في فيجوال بيسك للتطبيقات vba الموجودة ضمن حزمة ميكروسوفت أوفيس وسيكون الشرح على الأكسس microsoft access 2019 ومعالجة خطأ عدم ظهور الترجمة التعرف على أكواد لغات العالم world languages codes الموجودة في ترجمة جوجل وعددها 105 لغة التعرف على أسماء لغات العالم بالإنجليزية وباللغة العربية وباللغة المحلية لكل لغة دالة معرفة لإيقاف تنفيذ الكود فترة من الثواني wait مثل application.wait الموجودة في إكسل كتابة سطرين كود في سطر واحد نطق النصوص من خلال vba بجميع لغات العالم text to speech ترجمة سجلات الجداول أو الاستعلامات من خلال ADO وغيرها الكثيييييير اكتشفها بنفسك رابط القناة لمن لم يشترك معنا حتى الآن https://www.youtube.com/ostazmas2 #ostazmas ************ فتابعونا وقوموا بتفعيل زر الجرس للتنبيه وقت صدور الفيديو وعلق ولو بحرف لكي تدعمنا للاستمرار من أجلكم ********************* وفي هذه المرة لن أضع لكم الملف المستخدم في الشرح ولكن سأطلب ممن فهم الشرح أن يقوم بتطبيقه ويرفع لنا هنا ما تعلمه فعلا كنتيجة الفيديو ///////////////// وتذكر معي الحكمة القائلة: لا تعطني سمكة ولكن علمني كيف أصطاد

فورم ظهور الاعمدة فى الليست بوكس من اليمين للشمال والعكس الفيديو الصور حمل الملف ظهور الاعمدة في الليست بوكس بنفس ترتيبها.rar

السلام عليكم أساتذتى وإخوانى وأحبابى فى المنتدى :- ******************************************** مع كل شىء جديد فى الأكسل أصل إليه أحب أن أقدمه للمنتدى الذى تعلمت منه وفيه كرد للجميل الذى وهبنى إياه من قبل باختصار لو عندى 3 ملفات اكسل ( أ و ب و ج ) نقدر ننقل بيانات من ( أ ) إلى ( ج ) بدون فتح ( أ ) ولا فتح (ج ) ( انجليزى ده يا مرسى ؟؟؟؟ ) لأ مش انجليزى ولا ألمانى ولا حتى يابانى أو أمريكانى إنما هو مصرى خالص ووصعيدى كمان والمرفق التالى يوضح ذلك . طريقة التعامل مع المرفق : فك الضغط عن المرفق هتلاقى 3 ملفات mokhtar1 و mokhtar2 و mokhtar3 1- افتح mokhtar1 واكتب ما يبدو لك فى المدى المحدد ( A1 : C5 ) واقفله 2- رووووح على mokhtar2 فقط اضغط الزر " اقفل يا سمسم " 3- اجرى بسرعة على mokhtar3 وشوف النتيجة . الشرح والأكواد فى المرفق 123 كلمة سر الفيجوال بيسك . أكتفى بهذا الموجز وعلى حضرتك اكتشاف المزيد فى الملف . تحياتى لأساتذتى وزملائى copy data from a closed excel file & paste it in a closed excel file by mokhtar.rar

اشكرك جدا جدا جدا يا استاذ سليم و جزاك الله كل خير على الاهتمام و المساعدة الكود تمام و الحمدلله تم المطلوب مع بعض التعديلات البسيطة و الاهم هو طريقة حضرتك فى حل مشكلة تجميع ارقام الدالة if مرة اخرى اشكرك و فى ميزان حسناتك ان شاءالله

أهلا بك @محمد ابوعبد الله لديك طريقتان لعمل ما أشرت إليه - الطريقة الأولى: إنشاء متغير عام على في مستوى قاعدة البيانات يحمل اسم التقرير النشط، ثم نضع هذا المتغير موضع اسم التقرير في محدد مجموعة التقارير في النوذج كالتالي '-- تصريح لمتغير على في مستوى وحدة نمطية عامة Dim ActiveReprotName ActiveReportName=Screen.ActiveReport.Name If strSQL <> "" Then '-- Strip Last Comma & Space strSQL = left(strSQL, (Len(strSQL) - 2)) '-- Set the OrderBy property Reports![ActiveReportName].OrderBy = strSQL Reports![ActiveReportName].OrderByOn = True Else Reports![ActiveReportName].OrderByOn = False End If عيب هذه الطريقة أنك تحتاج إلى التأكد من أن النقرير النشط هو التقرير الذي تريد فرزه؛ وذلك من خارج النموذج - الطريقة الثانية: إنشاء قائمة منسدلة تعيد أسماء التقارير عند فتح نموذج الفرز ومن ثم تقوم بفتح التقارير عن طريق نموذج الفرز ، وتكون اسم التقرير العائد من القائمة المنسدلة هو نفسة التقرير في معالج الفرز.. وهذه الطريقة هي الأفضل.. للفائدة: أذا كانت اسماء التقارير لديك باللغة الإنجليزية (وهو المتوقع) قم بالنقر بالزر الأيمن للفارة على اسم التقرير ومن خصائص التقرير قم بإضافة وصف مختصر بالعربي للتقرير واستخدم هذا الوصف كاسم للتقرير في القائمة المنسدلة.. مثلك لا يحتاج إلى التعديل على المثال

إرسال بدون أوت لوك

هذا الكود يسمح لك بتحديد الخلية المحمية فقط دون ان يسمح بأي اجراء عليها(حذف--- تعديل---نسخ ---الخ) و يخفي المعادلة ايضاً و لا يأخذ بالحسبان الا المعادلات ( جربه و اعطني رأيك) Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Unprotect If Target.HasFormula Then With Target .Locked = True .FormulaHidden = True End With With ActiveSheet .Protect .EnableSelection = xllockedCells End With End If End Sub

بعد كود أستاذى ومعلمى ( رجب جاويش ) إليك الحل بالمعادلات ترحيل فى اماكن محدده.rar ترحيل فى اماكن محدده 2.rar

الاخ lord لاحظ الاتى : قمت بتعديل مدى الفرز لييناسب مع جدول الاختبار اعد المدى كما تريد بعد ذلك . فعلا يحدث هذا الخطأ مع الفرز بسب ديناميكية الدوائر (الفرز يختار مدى الفرز ويقوم بالترتيب ثم كود الدوائر يعمل بعد ذلك ويختار من مدى الدوائر خلية خلية فيحدث تعارض فى العناوين) ما علينا من الية عمل الدوائر للتغلب على هذه المشكلة اتبع الاسلوب الموجود فى موديول 7 وهو بالترتيب الاتى : قبل الفرز نعمل على ازالة معادلات الدوائر بالماكرو (Test1) . تنفيذ امر الغاء الدائر السطر الثانى فى الماكرو (Test1) . بعد الفرز نعيد كتابة معادلات الدوائر التى قمنا بأزالتها الماكرو (Test2) . بذلك لن يحدث اى خطأ ملاحظة اخرى : كود الدوائر فى ملفك هو النسخة الاولى من كود الدوائر قمت بوضع اخر نسخة للأستاذ السيد عبد العال من الكود بالملف احتفظ بها والغى الكود الذى عندك شاهد المرفق omar.rar