أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
هانى على ali mohamed ali-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة منع ادخال البيانات بعدة شروط اكسيل اسئله واجابات


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





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

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


موضوع مغلق


08-10-2020 06:14 مساء
محمدعبدالسلام
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-08-2017
رقم العضوية : 278
المشاركات : 166
الجنس : ذكر
تاريخ الميلاد : 19-6-1981
يتابعهم : 2
يتابعونه : 3
قوة السمعة : 185
 offline 


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

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

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

لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب



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 Sub












MEDce_30
 
 
 
  back.zip   تحميل zip مرات التحميل :(10)
الحجم :(1564.783) KB



أفضل إجابة مقدمة من hassona229 وهي:
عرض الإجابة




13-10-2020 07:50 صباحا
مشاهدة مشاركة منفردة [1]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 798
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 10
قوة السمعة : 4030
عدد الإجابات: 110
 offline 
look/images/icons/i1.gif طلب تعديل الكود الدى يقوم بعمل نسخة احتياطية

13-10-2020 10:50 مساء
مشاهدة مشاركة منفردة [2]
محمد الدسوقى
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 47
المشاركات : 827
الجنس : ذكر
تاريخ الميلاد : 14-10-1973
الدعوات : 79
يتابعهم : 9
يتابعونه : 765
قوة السمعة : 8651
عدد الإجابات: 8
 offline 
look/images/icons/i1.gif طلب تعديل الكود الدى يقوم بعمل نسخة احتياطية
أستاذ / محمد عبد السلام
الرجاء جعل الموضوع واحد وعدم إفراد طلب منفصل لكل جزئيه من المشروع لكى يمكن تتبعه من السادة الأعضاء بسهولة
واتفضل بعد إذن الأستاذ / حسنونه
الكود كامل بطلب جزئية ( رسالة التنبيه بالترحيل من عدمه )  ....... ده طلب كان موضوع  +  جزئية ( فصل الاسم عن التاريخ فى عمودين منفصلين ) و ....... ده كان طلب موضوع آخر ( بالرغم من أن المشروع واحد .. لعلك فهمت ما أقصد
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Boolean

Private Sub CommandButton1_Click()

    Dim wx As Workbook, ws As Worksheet, wss As Worksheet, wss2 As Worksheet, Nam, lr As Long
    Set wx = ThisWorkbook
    Set ws = wx.Sheets("invoice")
    Set wss = wx.Sheets("sheet1")
    Set wss2 = wx.Sheets("sheet2")
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
'-------------------------------------------------
 MD = MsgBox(" هل تريد الترحيل الى Sheet1  ؟" _
      , vbYesNo + vbQuestion + vbDefaultImage30 + vbApplicationModal, "أكاديمية الصقر للتدريب")
  If MD = vbNo Then
    Exit Sub
       End If
'-------------------------------------------------
    lr = wss.Range("a" & Rows.Count).End(xlUp).row + 1
        With ws
        
            Nam = .Range("e5")
            Da = Format(Now(), "dd-mm-yyyy hh.mm.ss")
            MakeSureDirectoryPathExists ThisWorkbook.Path & "\backup\"
            ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "\backup\" & Nam & ".xlsm"
            '=========================================
            If ws.[f5].Text = "اجل" Then
                wss.Range("a" & lr).Value = Nam
                wss.Range("a" & lr).Font.Color = 255
                wss.Range("B" & lr).Value = Da
                wss.Range("C" & lr).Value = "اجل"
                
          Else: wss.Range("a" & lr).Value = Nam
                wss.Range("B" & lr).Value = Da
                wss.Range("C" & lr).Value = "نقدي"
          End If
            If ws.[f5].Text = "اجل" Then
                wss2.Range("a" & lr).Value = Nam
                wss2.Range("a" & lr).Font.Color = 255
                wss2.Range("B" & lr).Value = Da
                wss2.Range("C" & lr).Value = "اجل"
          Else: wss.Range("a" & lr).Value = Nam
                wss2.Range("B" & lr).Value = Da
                wss2.Range("C" & lr).Value = "نقدي"
            End If
            '========================================
            '                 ActiveWorkbook.Close False
        End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
        MsgBox "تم حفظ نسخة باسم " & Nam & " ", vbInformation
End Sub


 

13-10-2020 11:08 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif طلب تعديل الكود الدى يقوم بعمل نسخة احتياطية
بارك الله فيك أخي الحبيب محمد الدسوقي
أفضل أن يكون الموضوع لطلب واحد فقط ليتمكن الأعضاء من العمل على الموضوع حيث أن الموضوع الذي فيه طلبات متعددة ينفر منه الأعضاء كما تقل الاستفادة منه لعدم تمكن معظم الأعضاء من متابعة الموضوع بالكامل في حالة الطلبات المتعددة.
ويمكن للعضو بعد الانتهاء من حل كل المشكلات التي تواجهه أن يرفق ملف نهائي يستفيد منه الأعضاء.

14-10-2020 02:42 صباحا
مشاهدة مشاركة منفردة [4]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 798
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 10
قوة السمعة : 4030
عدد الإجابات: 110
 offline 
look/images/icons/i1.gif طلب تعديل الكود الدى يقوم بعمل نسخة احتياطية
بارك الله فيك استاذنا محمد الدسوقي
وبارك فيك ابو البراء الغالي 
تسلموا علي الردود الجميله

14-10-2020 02:09 مساء
مشاهدة مشاركة منفردة [5]
محمدعبدالسلام
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-08-2017
رقم العضوية : 278
المشاركات : 166
الجنس : ذكر
تاريخ الميلاد : 19-6-1981
يتابعهم : 2
يتابعونه : 3
قوة السمعة : 185
 offline 
look/images/icons/i1.gif طلب تعديل الكود الدى يقوم بعمل نسخة احتياطية
اسف اخواني الكرام على طلباتي الكثيره والمواضيع المتكرره
 جزاكم الله خير الجزاء
 



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


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 08:01 صباحا