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

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

السلام عليكم ورحمة الله وبركاته
هذا الكود يقوم بعمل نسخة احتياطية للملف بنسخ اسم العمل وتاريخ في شيت 1 ويقوم بعمل نسخة احتياطية في D/DISK  طلب اريد تعديل الكود لفصل اسم السيد عن تاريخ في شيت 1

اريد اسم العميل في عمود A .وتاريخ في B. نواع تالفاتورة في عمود C

كما وضحت في سطر الأول في صورة
جزاكم الله خيرا وبارك فيكم

back_2.zip

 

Private Sub CommandButton1_Click()
 

Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("invoice")
Dim wss As Worksheet
Set wss = ActiveWorkbook.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(), " ss - mm - hh - yyyy - mm - dd ")
             With ws
                    Application.DisplayAlerts = False
                         Nam = .Range("e5") & " " & Format(Now(), " ss - mm - hh - yyyy - mm - dd ")
                               ThisWorkbook.SaveCopyAs Filename:="d:backBackup" & Nam & ".xlsm"
'
 '=========================================
                   End With

                  If ws.Range("F5").Value = "äÞÏí" Then
                   Else: wss.Range("a" & lr).Value = Nam
                    wss.Range("b" & lr).Value = "ÇÌá"
                     
                     wss.Range("b" & lr).Value = "ÇÌá"
                    End If
                                   
                 If ws.[f5].Text = "ÇÌá" Then
                   Else: wss.Range("a" & lr).Value = Nam
                    wss.Range("b" & lr).Value = "äÞÏí"
                     wss.Range("b" & lr).Value = "äÞÏí"
                    End If
   '========================================
'  äÓÎÉ ÇÍØíÇØíÉ


'   '========================================
'                 ActiveWorkbook.Close False
End Su

 

[حسين مامون]

عليكم السلام

جرب هذا التعديل 

ولكن مذا عن استعراص البيانات في الفورم ؟

سيأتر هذا عن ذلك وستضطر لتعديل الفورم

Private Sub CommandButton1_Click()
 

Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("invoice")
Dim wss As Worksheet
Set wss = ActiveWorkbook.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(), " ss - mm - hh - yyyy - mm - dd ")
             With ws
                    Application.DisplayAlerts = False
                         Nam = .Range("e5") & " " & Format(Now(), " ss - mm - hh - yyyy - mm - dd ")
                               ThisWorkbook.SaveCopyAs Filename:="D:\back\Backup\" & Nam & ".xlsm"
'
 '=========================================
                   End With

                  If ws.Range("F5").Value = "نقدي" Then
                   Else: wss.Range("a" & lr).Value = ws.Range("e5")
                    wss.Range("b" & lr).Value = Format(Now(), " ss - mm - hh - yyyy - mm - dd ")
                    wss.Range("C" & lr).Value = "اجل"
                    End If
                                   
                 If ws.[f5].Text = "اجل" Then
                   Else: wss.Range("a" & lr).Value = ws.Range("e5")
                    wss.Range("b" & lr).Value = Format(Now(), " ss - mm - hh - yyyy - mm - dd ")
                     wss.Range("C" & lr).Value = "نقدي"
                    End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[ala7bab]

وعليكم السلام ورحمة الله وبركاتة
جرب هذا التعديل
ان شاء الله يظبط معاك

Private Sub CommandButton1_Click()
 

Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("invoice")
Dim wss As Worksheet
Set wss = ActiveWorkbook.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(), " ss - nn - hh - yyyy - mm - dd ")
             With ws
                    Application.DisplayAlerts = False
                                                  Nam1 = .Range("e5")
                         Nam2 = Format(Now(), " ss - nn - hh - yyyy - mm - dd ")
                         Nam = Nam1 & " " & Nam2
                               ThisWorkbook.SaveCopyAs Filename:="d:backBackup" & Nam & ".xlsm"
'
 '=========================================
                   End With

                  If ws.Range("F5").Value = "äÞÏí" Then
                   Else: wss.Range("a" & lr).Value = Nam1
                    wss.Range("b" & lr).Value = Nam2
                     
                     wss.Range("c" & lr).Value = "ÇÌá"
                    End If
                                   
                 If ws.[f5].Text = "ÇÌá" Then
                   Else: wss.Range("a" & lr).Value = Nam1
                    wss.Range("b" & lr).Value = Nam2
                     wss.Range("c" & lr).Value = "äÞÏí"
                    End If
   '========================================
'  äÓÎÉ ÇÍØíÇØíÉ


'   '========================================
'                 ActiveWorkbook.Close False
End Sub

تم تعديل أكتوبر 9, 2020 بواسطه ala7bab

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

جزاكم الله خيرا  على الإهتمام بالموضوع اسف على تاخيرى في الرد عليكم كنت منشغلاً في العمل

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

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