أكاديمية الصقر للتدريب

اعلان هنا
أكاديمية الصقر للتدريب
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا




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


الرئيسية
نتائج البحث


نتائج البحث عن ردود العضو :Eslam Abdullah
عدد النتائج (1129) نتيجة
25-05-2019 03:09 مساء
icon نسخ صفحات اكسيل وحفظ كل واحدة في ملف جديد داخل مجلد | الكاتب :Eslam Abdullah |المنتدى: اكسيل اسئله واجابات
 استخدم الكود التالى عله يفى بالغرض
Sub Alsaqr()
Dim i%, wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 2 To Sheets.Count - 1
Set wb = Workbooks.Add
ThisWorkbook.Worksheets(i).Copy After:=wb.Worksheets(wb.Worksheets.Count)
wb.Worksheets(1).Delete
wb.SaveAs ThisWorkbook.Path & "\test2\" & i - 1
wb.Close False
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

ولو الملف به أكواد احفظ الملفات بصيغة xlsm مثلا بالكود التالى
Sub Alsaqr()
Dim i%, wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 2 To Sheets.Count - 1
Set wb = Workbooks.Add
ThisWorkbook.Worksheets(i).Copy After:=wb.Worksheets(wb.Worksheets.Count)
wb.Worksheets(1).Delete
wb.SaveAs ThisWorkbook.Path & "\test2\" & i - 1, 52
wb.Close False
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
25-05-2019 02:17 مساء
icon دالة معرفة لتأكيد تشابه النصوص | الكاتب :Eslam Abdullah |المنتدى: اكسيل شروحات ودروس
 ميغسى بوكو أغالى هذا بعض ما عندكم biggrin2
11-05-2019 08:45 مساء
icon ترحيل الى شيت اخر | الكاتب :Eslam Abdullah |المنتدى: اكسيل اسئله واجابات
 بارك الله فيك أستاذ ياسر
حلوه ياصحبى دى biggrin2
10-05-2019 12:01 صباحا
icon ترحيل الى شيت اخر | الكاتب :Eslam Abdullah |المنتدى: اكسيل اسئله واجابات
 
المشاركة الأصلية كتبت بواسطة:YasserKhalil
أحسنت أخي الحبيب إسلام .. جزاك الله خيراً
شكلك فطرت كويس النهاردة .. يلا الله يسهل لك الحال smile

ميغسى بوكو ، تلميذك بقى biggrin2
أنا معتش ورايا غير الفطار فى رمضان biggrin2
ووحوى ياوحوى ايووووحا biggrin2
يعنى ايه ايوحا blink


09-05-2019 11:57 مساء
icon الانتقال من فورم الى فورم عبر القائمة المنسدلة في الكمبوبوكس | الكاتب :Eslam Abdullah |المنتدى: اكسيل شروحات فيديو
 
المشاركة الأصلية كتبت بواسطة:YasserKhalil
دا شبهك يا سمسم وإنت في الخدمة smile

mad_1
09-05-2019 08:15 مساء
icon تحديد كل الخلايا اللتى تكون قيمتها تساوى قيمة الخلية المحددة | الكاتب :Eslam Abdullah |المنتدى: اكسيل اسئله واجابات
 بارك الله فيك أستاذى الغالى حسام 142
09-05-2019 08:07 مساء
icon الانتقال من فورم الى فورم عبر القائمة المنسدلة في الكمبوبوكس | الكاتب :Eslam Abdullah |المنتدى: اكسيل شروحات فيديو
 جزاك الله خيرا استاذ مجدى
حلوه الاطايف دى والفيديو برضوا biggrin2
بس الراجل سنته مكسوره وشكله زهقان يعينى biggrin2

09-05-2019 08:01 مساء
icon كل عام وانتم بخير ورمضان كريم | الكاتب :Eslam Abdullah |المنتدى: المنتدى العام
 
المشاركة الأصلية كتبت بواسطة:YasserKhalil
كل عام وانت بخير أخي وحبيبي في الله إسلام

حبيبى أستاذى الغالى وانت بكل خير وسعاده biggrin2biggrin2biggrin2
09-05-2019 07:54 مساء
icon ترحيل الى شيت اخر | الكاتب :Eslam Abdullah |المنتدى: اكسيل اسئله واجابات
 قمت بتعديل التعليق لاضافة الصور فى الصفحه

لكن حسب تطويع الكود الخاص بمستر ياسر الذى قمت بتعديله
لا يوجد ترحيل للعمود T وانما هى معادلات موجودة مسبقا لا أكثر
دا حسب فهمى ،،،

وبالنسبه لطلب استاذ ياسر على توضيح النقاط التى قمت بتعديلها فهى كالتالى
تم تعديل السطر التالى:
a = Array(Ws.Range("J4").Value, Ws.Range("B4").Value, Ws.Range("B5").Value, Ws.Range("H4").Value)

حيث تم تغير مواضع الخلايا J4 و B4 و B5 و H4
والسطر التالى:
b = Ws.Range("A12:I" & lr).Value

تم وضع النطاق الذى سيتم نقله من صفحة الرصيد
والسطر التالى:
b(i, 4) = b(i, 8): b(i, 5) = b(i, 9)

وذلك لان هناك عمودان خفيان بداخل النطاق فقمت بنقل بيانتهم
وترتيبهم داخل المصفوفه بالشكل الطبيعى
وسيتضح كلامى فى حالة قمت بتتبع الكود خطوه خطوه
مع ملاحظة النتائج فى نافذة Locals
وأخيرا السطر التالى:
sh.Range("L" & sh.Cells(Rows.Count, "L").End(xlUp).Row + 1).Resize(UBound(b, 1), UBound(b, 2)).Value = b

تم جعل البادئة لوضع النتائج من العمود L فقط















09-05-2019 04:04 مساء
icon كل عام وانتم بخير ورمضان كريم | الكاتب :Eslam Abdullah |المنتدى: المنتدى العام
 كل عام وانت بخير استاذ مجدى 81
احلى تحيه ارسلها لك من القوات المسلحه biggrin2
09-05-2019 12:35 صباحا
icon التحويل من اكسال الى ملف نصي d*ocument text | الكاتب :Eslam Abdullah |المنتدى: اكسيل اسئله واجابات
 جزاك الله خيرا استاذى الغالى ياسر
ودا شرح الكود استجابتا لطلب العضو سليم
Sub ExportToText(rng As Range, strFile As String)
Dim vR() As String, vTxt(), objStream
Dim strTxt As String, i As Long, j As Integer, n As Long
'انشاء كائن ADODB
'يستخدم لقرائة وكتابة وأدارة دفق من البيانات <<الثنائية>> أو النص
Set objStream = CreateObject("ADODB.Stream")
'انشاء حلقه تكراريه بعدد نطاق النص المراد نقله لملف نصى
For i = 1 To rng.Rows.Count
'عداد لمصفوفة لزيادة خانات المصفوفة vTxt
n = n + 1
'بعدد صفوف النص المراد نقلة للملف النصى vR اعادة تعيين المصفوفة
ReDim vR(1 To rng.Columns.Count)
'انشاء حلقه تكراريه بعدد نطاق النص المراد نقله لملف نصى
For j = 1 To rng.Columns.Count
'بالنص المراد نقله للملف النصى vR تعبئة المصفوفة
vR(j) = rng(i, j).Text
'استمرار الحلقة التكرارية
Next j
'يهدف امدادها بنص جديد vTxt اعادة تعيين المصفوفة
'للاحتفاظ ببيانات المصفوفة القديمة فى حالة امدادها بخانات جديدة Preserve تستخدم خاصية
ReDim Preserve vTxt(1 To n)
'للحفاظ على ان تكون المصفوفه احاديه Join بالنص المراد نقله للملف النصى واستخدام دالة vTxt تعبئة المصفوفة
'وليس الزام Join كفاصل هو مجرد افتراض لاستخدام دالة vbTab ملاحظة:استخدام
vTxt(n) = Join(vR, vbTab)
'استمرار الحلقة التكرارية
Next i
'ودمج خانات المصفوفة لتكون فوق بعض strTxt داخل المتغير النصى vTxt تعبئة المصفوفة
strTxt = Join(vTxt, vbCrLf)
'strTxt انشاء ملف نصى لوضع البيانات المستخلصه فيه من المتغير
'.فى كل سطر بعد وضع النقطة objStream لاستخدام الكائن With وضع خاصية
With objStream
'تعيين القيمه التى تحدد الى اى مجموعة احرف يتم ترجمة المحتويات ، تستخدم مع البيانات النصية
.Charset = "utf-8"
'فتح الملف النصى لمحرر للكود لغرض ملئه بالبيانات
.Open
'فى الملف النصى الجديد strTxt وضع النص المخزن داخل المتغير
.WriteText strTxt
'حفظ الملف النصى بنفس مسار ملف الاكسل
'ويستخدم فى حالة اضافة بيانات لهذالملف اذا كان موجود بالفعل adSaveCreateOverWrite رقم 2 يعنى
.SaveToFile strFile, 2
'اغلاق الملف النصى للكود
.Close
'With انهاء وضع الخاصية
End With
'لتقليل حجم البيانات المخزنة بالميمورى دون داعى objStream ازالة البيانات من الكائن
Set objStream = Nothing
End Sub




08-05-2019 11:24 مساء
icon ترحيل الى شيت اخر | الكاتب :Eslam Abdullah |المنتدى: اكسيل اسئله واجابات
 دا تطويع كود مستر ياسر على الملف المرفق
قبل اى شئ حول العمود Q فى صفحة "الرصيد" لتنسيق Text عشان الصفر فى اول الرقم
Sub TestArrays()
Dim a, b, Ws As Worksheet, sh As Worksheet, lr As Long, i As Long

Application.ScreenUpdating = False
Set Ws = ThisWorkbook.Worksheets("رئيسية")
Set sh = ThisWorkbook.Worksheets("الرصيد")

lr = Application.Max(Ws.Range("A12:A61").Value) + 11
If lr < 12 Then MsgBox "Cancelled", vbExclamation: Exit Sub

a = Array(Ws.Range("J4").Value, Ws.Range("B4").Value, Ws.Range("B5").Value, Ws.Range("H4").Value)
b = Ws.Range("A12:I" & lr).Value

For i = LBound(b) To UBound(b)
b(i, 4) = b(i, 8): b(i, 5) = b(i, 9)
b(i, 8) = b(i, 5)
b(i, 7) = b(i, 4)
b(i, 6) = b(i, 3)
b(i, 5) = b(i, 2)
b(i, 4) = a(3)
b(i, 3) = a(2)
b(i, 2) = a(1)
b(i, 1) = a(0)
Next i

sh.Range("L" & sh.Cells(Rows.Count, "L").End(xlUp).Row + 1).Resize(UBound(b, 1), UBound(b, 2)).Value = b
Application.ScreenUpdating = True
End Sub





الصفحة 1 من 95 < 1 2 3 4 95 > الأخيرة »





الساعة الآن 11:23 مساء

أعلن هنا
أعلن هنا
أعلن هنا