تعديل كود نقل الملف إلى سطح المكتب واستبدال الموجود مسبقا

[ابو تميم]

تحية طيبة

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

المطلوب هو التعديل على الكود بحيث إذا كان الملف موجود مسبقا يتم استبداله مباشرة وعدم ظهور رسالة من الويندوز تفيد بأن هذا الملف موجود بنفس الاسم هل ترغب بالاستبدال ؟؟

شكرا وجزاكم الله خيرا

نقل ملف.rar

[ابو تميم]

up

[الـعيدروس]

السلام عليكم

بيكون كالتالي

Sub outsheet()

MyWok = ActiveSheet.Name & ".xlsb"

MYPATH = Environ("homedrive") & Environ("HOMEPATH") & "\desktop" & "\" & MyWok

Dim Wok As Workbook

    For Each Wok In Workbooks

	    If Wok.Name = MyWok Then

		    ActiveSheet.Copy Before:=Workbooks(MyWok).Sheets(1)

		    Application.Windows(2).Activate

		    MsgBox ("تم نقل الملف إلى سطح المكتب"), vbMsgBoxRight, ("نقل ")

		  Exit Sub

	    End If

    Next

	    If Dir(MYPATH) = "" Then

		    ActiveSheet.Copy

		    ActiveWorkbook.SaveAs Filename:=MYPATH, FileFormat:=xlExcel12, CreateBackup:=False


		    Application.Windows(2).Activate

		    MsgBox ("تم نقل الملف إلى سطح المكتب")

		    Windows(MyWok).Close

	   Else

	   Application.DisplayAlerts = False

	    If MsgBox(" هذا الملف موجود مسبقا هل تريد إستبداله ", vbYesNo, "الملف موجود مسبقا") = vbNo Then Exit Sub

		    ActiveSheet.Copy

		    ActiveWorkbook.SaveAs Filename:=MYPATH, FileFormat:=xlExcel12, CreateBackup:=False

		    Application.Windows(2).Activate

		    MsgBox ("تم إستبدال الملف ونقله إلى سطح المكتب ")

		    Windows(MyWok).Close

	   Application.DisplayAlerts = True

		    Exit Sub

	    End If

End Sub

[ابو تميم]

أستاذنا القدير أبو نصار

جزاك الله خيرا وسلم يداك

هذا هو المطلوب ... لا حرمنا الله منك

جزاك الله خيرا

[الـعيدروس]

الاخ ابو تميم

بارك الله فيه ولك بالمثل اضعاف مضاعفه

تقبل تحياتي وشكري