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

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


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





مساعدة في تعديل الكود ليعمل على وندوز 10

السلام عليكم ورحمة الله وبركاته لدي ملف به كود vb يعمل جيداً مع وندوز 7 ولكن لا يعمل مع ويندوز 10 أرجو منكم إخوتي التعدي ..


موضوع مغلق


06-11-2020 12:32 مساء
sads
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 05-11-2020
رقم العضوية : 20714
المشاركات : 6
الجنس : ذكر
تاريخ الميلاد : 20-11-1980
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 24
 offline 

السلام عليكم ورحمة الله وبركاته
لدي ملف به كود vb يعمل جيداً مع وندوز 7 ولكن لا يعمل مع ويندوز 10 أرجو منكم إخوتي التعديل بالكود التالي ليعمل مع ويندوز 10
من فضلك لا تكرر نفس المشاركات ... تم بالفعل حذف المشاركة الأخرى
وضيفة الكود البحث في ملفات الإكسل وهي مغلقة

Sub information()
Range("a7:g1000").ClearContents
Dim wb As Workbook, rng As Range, lr As Integer
Dim sh As Range, fil As Variant, r As Integer, c As Integer
On Error GoTo 1
fnd = Workbooks("DATA").Sheets("INF").Range("b3").Value
c = Application.Match(fnd, Workbooks("DATA").Sheets("INF").Range("a5:f5"), 0)
INF = ThisWorkbook.Path
fil = Dir(INF & "*.xl??")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While fil <> ""
    If fil <> "DATA.xlsm" Then
        Set wb = Workbooks.Open(INF & "" & fil)
         r = 7
         lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
         For Each rng In ActiveSheet.Range(Cells(2, c), Cells(lr, c))
            If rng.Value = fnd Then
                ActiveSheet.Range(Cells(rng.Row, 1), Cells(rng.Row, 6)).Copy Workbooks("DATA").Sheets("INF").Cells(r, 1)
                Workbooks("DATA").Sheets("INF").Cells(r, 1).Offset(0, 6) = wb.Name
                r = r + 1
            End If
         Next rng
         ActiveWorkbook.Close
    End If
    fil = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
1:
MsgBox "اختار معيار البحث من فضلك"
End Sub
 
 
 
  كود يبحث داخل الملفات وهي مفلقة.rar   تحميل rar مرات التحميل :(7)
الحجم :(197.022) KB



أفضل إجابة مقدمة من hassona229 وهي:
عدل هذه الكلمة في جميع الكود

Workbooks("DATA")


الى هذه الكلمة

Workbooks("DATA.xlsm")
عرض الإجابة




07-11-2020 11:00 صباحا
مشاهدة مشاركة منفردة [1]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 808
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 11
قوة السمعة : 4330
عدد الإجابات: 113
 offline 
look/images/icons/i1.gif مساعدة في تعديل الكود ليعمل على وندوز 10
عدل هذه الكلمة في جميع الكود

Workbooks("DATA")


الى هذه الكلمة

Workbooks("DATA.xlsm")



الكلمات الدلالية
مساعدة ، تعديل ، الكود ، ليعمل ، وندوز ،


 










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

الساعة الآن 07:15 مساء