مساعدة فى حل خطاء run time error 9

[إبراهيم محمد]

بسم الله الرحمن الرحيم 

الاستاذة الافاضل   المحترمين 

مرفق كود يقوم بجلب صفحات من ملفات متعددة الى ملف العمل وتمكن المشكله عندم تصل الى مرحله الملف غلق الملف الذى تم النسخ منه فانه يعطى run time error 9  

وقد حاولت كثيرا فى تغير اسماء المتغيرات وتوحيدها ولكن دون جدوى  ولا اعرف ما السبب 

Option Explicit


Sub get_sheets_Path()
Application.DisplayAlerts = False 
Application.ScreenUpdating = False

Dim MyDialg As FileDialog, sspath As String, Fname As String, sheet As Worksheet, FileChosen As Integer, i As Integer
On Error GoTo Err_Test_MyPath
'==========================================
Set MyDialg = Application.FileDialog(msoFileDialogFilePicker)
'==========================================
1:
With MyDialg
    .AllowMultiSelect = True
    .Title = "احضار ملفات  "
    .InitialFileName = ActiveWorkbook.Path & "\"
    .Filters.Add "Excel File", "*.xls ; *.xlsx ; *.xlsm", 1
    .InitialView = msoFileDialogViewList
    FileChosen = .Show
End With
'==========================================
If MyDialg.SelectedItems.Count Then
    sspath = MyDialg.SelectedItems(1) '& Application.PathSeparator
    If Dir(sspath, vbDirectory) = vbNullString Then
        MsgBox " : لم يتم اختيار مسار صحيح " & vbCr & vbCr & sspath _
        & vbCr & vbCr & "يجب اختيار مسار صحيح  ", 524288, "مسار خاطىء"
        GoTo 1
    Else
' الكود بالاعلى من كتابه الاستاذ العلامه / عبد الله باقشير 
If FileChosen = -1 Then

For i = 1 To MyDialg.SelectedItems.Count

    Workbooks.Open MyDialg.SelectedItems(i), , ReadOnly:=True
    Fname = MyDialg.SelectedItems(i)
    
    ActiveWorkbook.Sheets.Select
    
    Sheets.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'after last sheet
    
    
    '-----------------------------------------------
    Workbooks(Fname).Close True '  عندما يصل الكود الى هنا يعطى الخطاء 
    
    '-------------------------------------------------
    
    
    
Next i
End If


Application.DisplayAlerts = True

MsgBox " تم تحميل جميع الصفحات بنجاح  "
      
    End If
End If
'==========================================
Err_Test_MyPath:
    If Err Then MsgBox "Err.Number:" & vbCr & Err.Number
    Set MyDialg = Nothing
    
End Sub

[احمدزمان]

السلام عليكم

اخي جرب استبدال السطر الذي به الخطأ بهذا

    Workbooks(Workbooks.Count).Close

واتمنى ان يتم تجاوز الخطأ

[إبراهيم محمد]

الاستاذ الفاضل / احمد زمان 

 

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

[بن علية حاجي]

السلام عليكم ورحمة الله

 

 

أخي الكريم إبراهيم، المشكل كله يكمن في السطر من الكود الذي ذكرت أنه "عندما يصل الكود إليه يعطي الخطأ" وهو  Workbooks(Fname).Close True لذا أقترح عليك استبداله بالجزء التالي :

  For Each Wbk In Excel.Workbooks
      If Wbk.Name <> ThisWorkbook.Name Then
          Wbk.Close
      End If
Next

دون أن تنسى الإعلان في بداية الكود بالمتغير Wbk باستعمال العبارة  Wbk As Excel.Workbook

 

وقد وضعت الكود كاملا في الملف المرفق التالي: test.rar

 

أخوك بن علية

 

 

[إبراهيم محمد]

الاستاذ الفاضل / بن عليه حاجي 

لك خالص الشكر والتقدير على اهتمامك وردك على الموضوع  وانا حملت الملف ولكن عند تجربته طلع رقم خطاء اخر وهو 1004  

وفى الحقيقه مع بعض البحث تبين ان الخطاء رقم 9 من اسبابه ان المتغير fname  يحتفظ بالمسار كاملا للاسم  والامر close  يريد الاسم فقط دون باقى المسار  ومن هنا تاتى هذة الرساله 

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

ويهمنى تقيمك ونصحك الكريم لهذا الامر 

وجزاك الله كل خير وفى انتظار ردك الكريم 

Option Explicit




Sub get_sheets_Path()
Dim i As Integer
Dim objfl As Variant
Dim sFileName As String

Application.DisplayAlerts = False ' áÊÚØíá ÑÓÇÆá ÇáÊÍÐíÑ
Application.ScreenUpdating = False

Dim MyDialg As FileDialog, sspath As String, Filename As String, sheet As Worksheet
'On Error GoTo Err_Test_MyPath
'==========================================
Set MyDialg = Application.FileDialog(msoFileDialogFilePicker)
'==========================================
1:
With MyDialg
    .ButtonName = "Select"
    .AllowMultiSelect = True
    .Filters.Add "Excel Files", "*.xls;*.xlsx;*.xlsm", 1
    .Title = "ÇÎÊíÇÑ ÇáãáÝÇÊ ÇáãØáæ È ÇÖÇÝå ÕÝÍÇÊåÇ "
    .InitialView = msoFileDialogViewDetails
    .InitialFileName = ActiveWorkbook.Path & "\"
    .Show
    For Each objfl In .SelectedItems
        Filename = objfl
    If Filename <> ThisWorkbook.Name Then
        Workbooks.Open Filename:=Filename, ReadOnly:=True
    
        For Each sheet In ActiveWorkbook.Sheets
            sheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'after last sheet
        Next sheet
        sFileName = Split(Filename, "\")(UBound(Split(Filename, "\")))
        Workbooks(sFileName).Close
    End If
    Next objfl
    On Error GoTo 0
End With

Set MyDialg = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox " Êã ÊÍãíá ÌãíÚ ÇáÕÝÍÇÊ ÇáÊì ÈÇáãáÝÇÊ  ÈäÌÇÍ "

End Sub

[بن علية حاجي]

السلام عليكم ورحمة الله

 

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

 

أخوك بن علية

[إبراهيم محمد]

الاستاذ الفاضل / بن عليه حاجي 

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

ولكن الكود فى صورته الاخيرة قد عمل معي الان بشكل جيد 

وقد جربت مساءله فصل الاسم فى صورة الكود لاولى ولكنها لم تنجح 

ولكنها نجحت مع الصورة الثانيه 

بارك الله فيك استاذنا الغالى واشكرك جزيل الشكر على هذا التفاعل والاهتمام البناء والذى ننتظرة منكم دائما 

تقبل تحياتي وتقديرى واحترامي 

[احمدزمان]

السلام عليكم

اخي جرب استبدال السطر الذي به الخطأ بهذا

    Workbooks(Workbooks.Count).Close

واتمنى ان يتم تجاوز الخطأ

 

 

الاستاذ الفاضل / احمد زمان 

 

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

 

السلام عليكم و رحمة الله وبركاته

 

بعد اذن اخي بن عليه جزاه الله خيرا

 

هذا الكود يقوم باغلاق آخر ملف اكسل تم فتحه

ولاحظت في الكود انه يتم فتح ملف محدد من داخل الكوود

لذلك يكون

workbooks.count

هو الملف الذي تم فتحه من داخل الكود الحالي

[إبراهيم محمد]

الاستاذ  الفاضل    احمد مازن 

بالفعل لقد قمت بتجربه الكود ويقوم باغلاق الملف الاخير ويترك الملف الاصلي 

ولا تظهر خطاء الكود  رقم 9  مرة اخرى 

بارك الله فيك استاذنا الغالى والف شكر على اهتمامك وسعيك للمساعدة وتوصيل المعلومه 

والشكر موصول للاستاذ بن عليه حاجي  ولكل اساتذة المنتدى  الكرام