اذهب الي المحتوي
أوفيسنا

مطلوب كود فتح ملف من مسار اخر


الردود الموصى بها

السادة الافاضل

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

d:new folder/salah/123.xls

 

تم تعديل بواسطه صلاح الصغير
رابط هذا التعليق
شارك

السلام عليكم أخي صلاح

جرب الكود التالي

Sub OpenClosedWB()
    Const strInput  As String = "123.xlsx"
    Dim wbk         As Workbook

    On Error Resume Next
        Set wbk = Workbooks(strInput)
        If wbk Is Nothing Then
            Set wbk = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strInput, ReadOnly:=True)
            If wbk Is Nothing Then
                MsgBox strInput & " Not Found!", vbCritical
                Exit Sub
            End If
        Else
            wbk.Activate
        End If
    On Error GoTo 0
End Sub

 

رابط هذا التعليق
شارك

و عليكم السلام اخى ياسر

هاجربه بعد الاجازة ان شاء الله 

بس انا كنت طالب لو فيه ملفات اخرى عايز افتحها

التعديل هيكون ازاى

و اسف للاطالة

رابط هذا التعليق
شارك

لم أفهم النقطة التي تتكلم فيها .. ملفات أخرى بأي شكل 

الكود يتعامل مع ملف مغلق تحدد اسمه ومساره .. 

هل تقصد هذه الطريقة ؟؟!!

Private Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long

Sub Test()
    Dim openFile    As Variant
    Dim wbk         As Workbook

    SetCurrentDirectoryA ThisWorkbook.Path & "\"
    openFile = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS*), *.XLS*", Title:="Select File To Be Opened")
    If openFile = False Then Exit Sub

    On Error Resume Next
        Set wbk = openFile
        If wbk Is Nothing Then
            Set wbk = Workbooks.Open(Filename:=openFile, ReadOnly:=True)
            If wbk Is Nothing Then
                MsgBox openFile & " Not Found!", vbCritical
                Exit Sub
            End If
        Else
            wbk.Activate
            ActiveWindow.WindowState = xlMaximized
        End If
    On Error GoTo 0
End Sub

 

رابط هذا التعليق
شارك

ا / ياسر

شكرا لاهتمامك كالعادة

طبعا انا مش عارف الفرق بين الكودين لانى مجربتش

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

مثال للتوضيح

عندى ملف اسمه س

 عايز لما افتحه يفتح ملف ص و ع و ل

و لو فيه ملف مفتوح منهم ميحصلش مشكلة

و ليكن مثلا المسار كالاتى

d:/salah/ص.xls

d:/yasser/ع.xls

d:/salah/yasser/ل.xls

اتمنى اكون وضحت المطلوب

و شكرا

تم تعديل بواسطه صلاح الصغير
edit
رابط هذا التعليق
شارك

المطلوب قد يكون واضح بالنسبة لك ..لكن المشكلة أنك تتكلم بشكل عام مما يجعل من يريد المساعدة لا يدري من أين يبدأ ..

لابد من وضع معالم للطلب داخل الموضوع ..كن محدد الهدف BE SPECIFIC ...

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

تقبل تحياتي

رابط هذا التعليق
شارك

ا / ياسر

اولا عذرا لعدم التوضيح و لكن بشكل عام سوف اوافيكم بالشكل المطلوب لاحقا 

و ردا على سؤال حضرتك افكارك دائما تعجبنى كنت اريد اسماء الملفات المراد فتحها مدمجة داخل الكود

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

و اتمنى الموضوع اكون وصلته لحضرتك و يفيد الجميع

و شكرا

رابط هذا التعليق
شارك

ا / ياسر

عفوا ليس تحت يدى جهاز الان

و كيف ارسل مثلا فولدر به الملف الاصلى و ثلاثة ملفات اخرى و انا اريد فتح الملفات الثلاثة من اكثر من مسار مختلف كما زكرت

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

رابط هذا التعليق
شارك

أخي الكريم صلاح

أنا في معظم الوقت لا أعمل على التخمين لأنه لن يفيد .. قم بإرفاق ملف إكسيل فيه التصور الذي تتخيله مع بعض الملفات الوهمية .. ليس شرط الملفات الأصليه ..أي ملفات تكون بنفس الاسم والامتداد ولا يهم المضمون ... المهم الفكرة المطلوبة أنت تقوم ببلورتها في ملف لنفهم مقصدك

 

رابط هذا التعليق
شارك

أخي الكريم صلاح

جرب الكود التالي ويمكن وضعه في حدث فتح المصنف .. أو كما ترغب فيما بعد

Sub OpenClosedWBs()
    Dim wbk         As Workbook
    Dim ws          As Worksheet
    Dim strInput    As String
    Dim i           As Long
    Dim p           As Long
    Dim lr          As Long
    
    Application.ScreenUpdating = False
        On Error Resume Next
            Set ws = ThisWorkbook.Sheets("Sheet1")
            For i = 2 To ws.Cells(Rows.Count, "H").End(xlUp).Row
                p = InStrRev(ws.Range("H" & i), "\") + 1
                strInput = Mid(ws.Range("H" & i), p)
                Set wbk = Workbooks(strInput)
        
                If wbk Is Nothing Then
                    Set wbk = Workbooks.Open(Filename:=ws.Range("H" & i))
                    If wbk Is Nothing Then
                        MsgBox ws.Range("H" & i) & " Not Found!", vbCritical
                        Exit Sub
                    End If
                End If
                
                With wbk.Sheets(1)
                    Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).Activate
                End With
                
                Set wbk = Nothing
            Next i
        On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

 

  • Like 3
رابط هذا التعليق
شارك

ا / ياسر

شكرا لسرعة الرد

و لكن دائما يعطى رسالة not found

هل ممكن اكون انا بكتب المسار غلط

انا كتبت المسار بالكامل فى الخلية h2

و شكرا

تم تعديل بواسطه صلاح الصغير
edit
  • Like 1
رابط هذا التعليق
شارك

وضع ال / غلط 

صحتها

d:\salah\ص.xls

جزيل الشكر والعرفان للأستاذ الافاضل

المبدع دائما

ربنا يزيدك علما وحكمة

ولجميع الخبراء والاصدقاء اصحاب المنتدى العظيم 

جامعة أوفسينا 

تعلمنا منكم الكثير والكثير فى صمت وادب وحب

  • Like 2
رابط هذا التعليق
شارك

الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات ..

أين الإعجاب بالمشاركة الصحيحة واختيار أفضل إجابة ليكون مرجع لمن أراد البحث فيما بعد .. :)

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information