ريان أحمد قام بنشر أبريل 16, 2011 مشاركة قام بنشر أبريل 16, 2011 السلام عليكم المشكلة في نوع الملف عندما إخترت الملف QTT01_04.11 لا يقبله لأنه من نوع bdf4 وليس xls والصورة المرفقة توضح دلك ثاني شيئ في ملف tahar الذي يحتوي على الكود في ورقة 01 وورقة 02 أريد الكود يقوم بنسخ إلى ورقة 01وليس الورقة التي فيها الكود وجزاكم الله كل خير tahar.rar رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أبريل 16, 2011 مشاركة قام بنشر أبريل 16, 2011 السلام عليكم عندما إخترت الملف QTT01_04.11 لا يقبله لأنه من نوع bdf4 وليس xls الكود يتعامل مع ملفات الاكسل التي من نوعية نوع الملف "xls" في ملف tahar الذي يحتوي على الكود في ورقة 01 وورقة 02 أريد الكود يقوم بنسخ إلى ورقة 01وليس الورقة التي فيها الكود في بداية الكود ضع اسم الورقة التي تريد لصق البيانات فيها Const MySheet_Post As String = "post" وهذا الكود المستخدم: Option Explicit Option Compare Text ' اسم الورقة التي سيتم لصق البيانات فيها Const MySheet_Post As String = "post" ' Sub kh_copy_mydate() Dim sh As Worksheet Dim MyFilOpen As String, MyPath As String, MyBook As String '===================== On Error GoTo Err_mydate '===================== Set sh = ActiveWorkbook.Worksheets(ActiveSheet.Name) Application.ScreenUpdating = False '===================== With sh MyPath = CStr(.Range("C1")) & ":\" & CStr(.Range("D1")) & "\" MyBook = CStr(.Range("C16")) & ".xls" End With '===================== Set sh = ActiveWorkbook.Worksheets(MySheet_Post) '===================== MyFilOpen = MyPath & MyBook '===================== If Dir(MyFilOpen, vbDirectory) = vbNullString Then MsgBox "رابط غير موجود" Else Workbooks.Open Filename:=MyFilOpen Sheets(1).Columns("A:A").Copy sh.Range("A1") Workbooks(MyBook).Close False MsgBox "تم نسخ البيانات الى الورقة : " & vbCr & MySheet_Post sh.Activate End If '===================== Err_mydate: If Err Then MsgBox "Err.Number:" & vbCr & Err.Number '===================== Application.ScreenUpdating = True Set sh = Nothing End Sub شاهد المرفق اكسل 2003 tahar1.rar رابط هذا التعليق شارك More sharing options...
ريان أحمد قام بنشر أبريل 16, 2011 الكاتب مشاركة قام بنشر أبريل 16, 2011 السلام عليكم شكرا على المرور السريع والمتألق بالنسبة للمطلوب الأول فهو المطلوب ووبلا شك أستاذي خبور الملف الذي بإسم QTT01_04.11 هو من نوع dbfمصمم في لغة برمجة dbase وليس bdf كما دكرت سابقا فالمعذرة أما إذا كانت هذا النوع كذلك لا يستطيع التعامل معه الكود فعندي حل الرجاء مساعدتي فيه بالكود والشرح في المرفق الملف tt الذي في المرفق هو ملف يحتوي على الملفات التي بنوع dbf يقوم الماكرو بفتح الملفات في tt وحفضها بإسم تبعا للخلية c16 مع الحفاض على الملف الأصلي ثم أرجع للخلية c16 لأجد فيها ملف بصيعة xls وينجح كود تبعك Archive.rar رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أبريل 16, 2011 مشاركة قام بنشر أبريل 16, 2011 السلام عليكم اما إذا كانت هذا النوع كذلك لا يستطيع التعامل معه الكود لقد تم التعامل مع الملف والحمد لله تم التعديل على الكود كما يلي: Option Explicit Option Compare Text ' اسم الورقة التي سيتم لصق البيانات فيها Const MySheet_Post As String = "post" ' Sub kh_copy_mydate() Dim sh As Worksheet Dim MyFilOpen As String, MyPath As String, MyBook As String '===================== On Error GoTo Err_mydate '===================== Set sh = ActiveWorkbook.Worksheets(ActiveSheet.Name) Application.ScreenUpdating = False '===================== With sh MyPath = CStr(.Range("C1")) & ":\" & CStr(.Range("D1")) & "\" MyBook = CStr(.Range("C16")) & File_Type(MyPath & .Range("C16")) End With '===================== Set sh = ActiveWorkbook.Worksheets(MySheet_Post) '===================== MyFilOpen = MyPath & MyBook '===================== If Dir(MyFilOpen, vbDirectory) = vbNullString Then MsgBox "رابط غير موجود" Else Workbooks.Open Filename:=MyFilOpen Sheets(1).Columns("A:A").Copy sh.Range("A1") Workbooks(MyBook).Close False MsgBox "تم نسخ البيانات الى الورقة : " & vbCr & MySheet_Post sh.Activate End If '===================== Err_mydate: If Err Then MsgBox "Err.Number:" & vbCr & Err.Number '===================== Application.ScreenUpdating = True Set sh = Nothing End Sub ------------------------------------ Function File_Type(MyTest As String) As String Dim MyType As String MyType = ".xls" If Not Dir(MyTest & MyType, vbDirectory) = vbNullString Then File_Type = MyType End If End Function شاهد المرفق tahar2.rar رابط هذا التعليق شارك More sharing options...
ريان أحمد قام بنشر أبريل 17, 2011 الكاتب مشاركة قام بنشر أبريل 17, 2011 السلام عليكم نعم كالعادة وبلا شك متميز ومتألق نعم هو المطلوب بعينه بارك الله فيك وفي حسناتك وفي عمرك وجعلك دائما بصحة وعافية ووفقك لمرضاته يارب إعطيه مايتمنى وأقضي مافي باله أمين يا رب العالمين لكن بقي طلب صغيييييييييييييييييييييييييييييييييييييييييييييييير هو أن أجعل كل هذا في فورم أي مكان إدخال إسم الملف ا والدرايف وإسم الملف الذي في الخلية c16 وهذه الفورم يتم إستذعاؤها بزر كذلك ماهي الملفات التي يتعامل معها الكود بخلاف xls *dbf رابط هذا التعليق شارك More sharing options...
ريان أحمد قام بنشر أبريل 17, 2011 الكاتب مشاركة قام بنشر أبريل 17, 2011 (معدل) تم تعديل أبريل 17, 2011 بواسطه tahar1983 رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر أبريل 18, 2011 مشاركة قام بنشر أبريل 18, 2011 لكن بقي طلب صغيييييييييييييييييييييييييييييييييييييييييييييييير هو أن أجعل كل هذا في فورم أي مكان إدخال إسم الملف ا والدرايف وإسم الملف الذي في الخلية c16 وهذه الفورم يتم إستذعاؤها بزر كذلك ماهي الملفات التي يتعامل معها الكود بخلاف xls *dbf اخي طاهر وبعد اذن استاذنا خبور خير حفظه الله تفضل المرفق اخوك ابو احمد tahar3.rar رابط هذا التعليق شارك More sharing options...
محب إكسل قام بنشر أبريل 19, 2011 مشاركة قام بنشر أبريل 19, 2011 شكرا جزاك الله كل خير رابط هذا التعليق شارك More sharing options...
محب إكسل قام بنشر أبريل 21, 2011 مشاركة قام بنشر أبريل 21, 2011 شكرا أخي ولد مجرب وبارك الله فيك وجزاك الله كل خير أنت وكل عضو يقوم بالسهر على سير هذا المنتدى العضيم رابط هذا التعليق شارك More sharing options...
ريان أحمد قام بنشر أبريل 21, 2011 الكاتب مشاركة قام بنشر أبريل 21, 2011 السلام عليكم أستاذي ولد مجرب أستاذي خبور إلى كل أساتذة المنتدلى شكرا وألف شكر على المجهودات الجبارة التي تبذلونها من اجل المنتدى والنهوض به وبقاء سيرورته شكرا عل المرور الطيب وجزاكم الله كل خير رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان