حفظ ملف العمل

[mohamed.youssef]

السلام عليكم

الاخوة الافاضل الملف المرفق اريد عند الضغط على زر حفظ يقوم الكود بنسخ ملف العمل بنسخة احتياطية الى درايف D فيل اغلاق الملف وشكرا

MMMM.xlsm

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

[احمد عبدالحليم]

استخدم  خاصية البحث اخى الفاضل تمت الاجابة على نفس السؤال فى هذا الموضوع https://www.officena.net/ib/topic/120628-نسخة-احتياطيه/?do=findComment&comment=726185

وهذا ملف للمطلوب 

ملحوظة من الافضل عدم وضع ملف العمل على سطح المكتب تجنبا لحدوث مشاكل فى الويندوز وفقدان ملف العمل

MMMM.xlsm

[mohamed.youssef]

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

[احمد عبدالحليم]

تفضل حفظ بنفس الاسم وبدون تاريخ

MMMM.xlsm

[mohamed.youssef]

الف شكر استاذي الفاضل على مساعدة حضرتك تمام ولكن عند وضع الملف على جهاز اخر لايوجد به درايف d وقمت بتغير الكود على ان يتم الحفظ على درايف C حدث مشكلة فهل الكود لايتم تشغيله على اي درايف اخر غير d مع الشكر انا عارف اني تاعب حضرتك 

[محمد هشام.]

تفضل جرب 

Private Sub CommandButton1_Click()   'كود لانشاء نسخة احتياطية للملف
Dim F As Workbook, J As String, Folder As String, ST As Boolean
Dim B, A, ST_Path, strPath  As String
On Error GoTo NotAbleToSave
Set F = ThisWorkbook
A = "Backup"  ' اسم مجلد الحفظ 
B = F.Name
strPath = "C:\"    ' تحديد مسار الحفظ
Application.DisplayAlerts = False
On Error Resume Next
If IsEmpty(A) Then Exit Sub
If IsEmpty(B) Then Exit Sub
MkDir strPath & "\" & A
ST_Path = strPath & "\" & A & "\" & B
Folder = "C:\Backup\"   ' تحديد مسار مجلد الحفظ
J = F.Name
ST = False
If F.Path = "" Then
   Application.Dialogs(xlDialogSaveAs).Show
Else
    If Dir(Folder & J) <> "" Then
        Kill Folder & J
    End If

    '(Save) لحفظ الملف النشط تلقائيا يمكنك تفعيل هدا السطر
    With F
        '.Save
        .SaveCopyAs Folder & J
        ST = True
    End With
End If
NotAbleToSave:
    Set F = Nothing
If Not ST Then

End If
MsgBox " : تم حفظ الملف في مجلد" & vbLf & vbLf & Folder & "" & J & vbLf & "" & vbLf & vbCrLf, vbInformation + vbOKOnly, " ! تعليمات"
    Application.DisplayAlerts = True

End Sub

 

MMM.xlsm

[mohamed.youssef]

الف شكر للاساتذة الكرام على المساعدة ومجهود سيادتكم