طلب تعديل كود لعمل نسخة احتياطية

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

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

في الملف المرفق كود  الاستاذ / حسين مامون  .. جزاه الله خيرا 

اريد تعديل الكود لي انا سم الفاتورة يتغير في كل نسخةاحتياطية اسم الملف هو الفاتورة وفي نسخة الإحتياطية يصبح الملف بهدا الاسم خاليد 25 10 2019  09 32 54 المشكلة عند نقر على زر لعمل نسخة أخرى يظهر لي هدا الخطأ في صورة باللون الاصفر

 

back.rar

https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=168485

 

 

 

back.rar

[حسين مامون]

عليكم السلام استاذ محمد عبد السلام 

غير السطور التالية الى ما يلي وجرب 

Private Sub CommandButton1_Click()
' saveas_facture()
'Dim wx As Workbook
'Set wx = Workbooks("ÝÇÊæÑÉ")

Dim ws As Worksheet
Set ws = Workbooks("فاتورة").Sheets("invoice")
Dim wss As Worksheet
Set wss = Workbooks("فاتورة").Sheets("sheet1")

 

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

اخي الكريم حسين مامون  .. جزاه الله خيرا 

ولكن عندا تغير السطورونقر على زر يظهر لي هذا الخطأ

 

 

 

 

 

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Set ws = Workbooks("فاتورة").Sheets("invoice")
Dim wss As Worksheet
Set wss = Workbooks("فاتورة").Sheets("sheet1")

Dim ws As Worksheet
Set ws = wx.Sheets("invoice")
Dim wss As Worksheet
Set wss = wx.Sheets("sheet1")
Dim DT
Dim Nam
Dim lr As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
             lr = wss.Range("a" & Rows.Count).End(xlUp).row + 1
             DT = ws.Range("e5") & Format(Now(), "dd-mm-yyyy hh mm ss")
             With ws
'                .Copy
'                .UsedRange = .UsedRange.Value
                    Application.DisplayAlerts = False
'                        Nam = "d:\back\backup\فاتورة" & DT & ".xlsx"
                          Nam = .Range("e5") & " " & Format(Now(), "dd mm yyyy  hh mm ss")
                               ThisWorkbook.SaveCopyAs Filename:="D:\back\Backup\" & Nam & ".xlsm"
'                        ActiveWorkbook.SaveAs Nam, FileFormat:=xlOpenXMLWorkbook
 '=========================================
                    If ws.[f5].Text = "اجل" Then
                    wss.Range("a" & lr).Value = Nam
                    wss.Range("a" & lr).Font.Color = 255
                    wss.Range("b" & lr).Value = "اجل"
                   Else: wss.Range("a" & lr).Value = Nam
                    wss.Range("b" & lr).Value = "نقدي"
                    End If
   '========================================
'                 ActiveWorkbook.Close False
              End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
                                        MsgBox "تم حفظ نسخة باسم " & DT & " ", vbInformation
End Sub

 

تم تعديل نوفمبر 21, 2019 بواسطه محمد عبدالسلام

[حسين مامون]

لم تقم يتغيير السطور كما يجب 

عموما ارفع الكود كما هو لتعديله 

[حسين مامون]

عدل كما في الصورة

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

اخي الكريم حسين مامون  .. جزاه الله خيرا

ولكن مازال هذا الخطأ عند تغيير اسم الملف في هذا سطر من فاتورة الااسم اخر

[حسين مامون]

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Set ws = Workbooks("فاتورة").Sheets("invoice")
Dim wss As Worksheet
Set wss = Workbooks("فاتورة").Sheets("sheet1")

'Dim ws As Worksheet
'Set ws = wx.Sheets("invoice")
'Dim wss As Worksheet
'Set wss = wx.Sheets("sheet1")
Dim DT
Dim Nam
Dim lr As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
             lr = wss.Range("a" & Rows.Count).End(xlUp).row + 1
             DT = ws.Range("e5") & Format(Now(), "dd-mm-yyyy hh mm ss")
             With ws
'                .Copy
'                .UsedRange = .UsedRange.Value
                    Application.DisplayAlerts = False
'                        Nam = "d:\back\backup\فاتورة" & DT & ".xlsx"
                          Nam = .Range("e5") & " " & Format(Now(), "dd mm yyyy  hh mm ss")
                               ThisWorkbook.SaveCopyAs Filename:="D:\back\Backup\" & Nam & ".xlsm"
'                        ActiveWorkbook.SaveAs Nam, FileFormat:=xlOpenXMLWorkbook
 '=========================================
                    If ws.[f5].Text = "اجل" Then
                    wss.Range("a" & lr).Value = Nam
                    wss.Range("a" & lr).Font.Color = 255
                    wss.Range("b" & lr).Value = "اجل"
                   Else: wss.Range("a" & lr).Value = Nam
                    wss.Range("b" & lr).Value = "نقدي"
                    End If
   '========================================
'                 ActiveWorkbook.Close False
              End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
                                        MsgBox "تم حفظ نسخة باسم " & DT & " ", vbInformation
End Sub

 

 

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

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

 

تم تعديل نوفمبر 21, 2019 بواسطه محمد عبدالسلام

[حسين مامون]

لم تقم بتعديل الكود كما قلت

منذ مشاركتي الاولى لم اغير شيء في الكود بس المشكلة في شرح الموضوع 

عموما احذف السطرين المحاطين بالاسود في الصورة

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

اخي حسين مامون

لقد قومت بتغير اسم الملف

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

 

back.zip

تم تعديل نوفمبر 21, 2019 بواسطه محمد عبدالسلام

[حسين مامون]

اخي الكريم 

طبيعي ان يعمل الكود خطا ادا غيرنا اسمه او مساره 

يمكنك تغيير اسم الملف ولكن يجب تغييره ايضا في الكود

تحياتي

او تغيير الاسطر الاولى في الكود الى ما يلي

ولك فيحالة التعامل مع اكثر من ملف ستكون مشاكل 

Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("invoice")
Dim wss As Worksheet
Set wss = ActiveWorkbook.Sheets("sheet1")

 

تم تعديل نوفمبر 22, 2019 بواسطه حسين مامون

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

اخي الحبيب حسين مامون

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

[حسين مامون]

وجزيت خيرا اخي الكريم

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

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

اخي الكريم واستاذي الفاضل

الكود عند تعديل  يعمل بشكل رائع

لكن قد حدث نفس الخطا في كود استعلام يوزر فورم عندما تغير اسم الملف

لقد ظهرت مشكلة في كود الاستعلام في يوزرفورم عندما يتم نقر اقدي اواجل يظهر هدا الخطأ في هاد سطرين

back.zip 870.68 kB · 5 تنزيلات

 

 

تم تعديل نوفمبر 23, 2019 بواسطه محمد عبدالسلام

[حسين مامون]

عليكم السلام

كما قلت لك ستحصل مشاكل اخرى واخرى واخرى 

حاول تغيير السطر الذي فيه خطأ الى Activeworkbook.sheets 

set sh = activeworkbook.sheets("sheet1")

ثم الثاني 

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

رائع جداً أخي الفاضل  وفقك الله تعالى وجزاك الله خير الجزاء