gamal saad قام بنشر سبتمبر 14, 2023 مشاركة قام بنشر سبتمبر 14, 2023 برجاء تفعيل الكود دا على ملف الاكسل المرفق Sub Auto_Open() Dim MyTime As Date MyTime = TimeSerial(10, 0, 0) ' بداية عمل الكود بعد فتح الملف Application.OnTime MyTime, "ExportSpecificSheet" End Sub Sub ExportSpecificSheet() Dim WB As Workbook, WS As Worksheet, fName As String Set WS = ThisWorkbook.Sheets("Sheet2") ' حدد اسم الشيت fName = "D:\" & "نسخة من البيان الوقتى" & "(" & Format(Now, "dd-mm-yyyy hhmmss") & ")" & ".xlsx" ' حدد اسم و مسار وامتداد الملف Application.ScreenUpdating = False Application.DisplayAlerts = False If WB Is Nothing Then WS.Copy WS.UsedRange.Value = WS.UsedRange.Value Set WB = ActiveWorkbook With WB .SaveAs Filename:=fName .Close True End With End If Set WS = Nothing Set WB = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Your's Sheet Exported Now ...", 64 End Sub بيان وقتى.xlsx رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر سبتمبر 14, 2023 مشاركة قام بنشر سبتمبر 14, 2023 Private Sub Workbook_Open() 'بداية عمل الكود بعد فتح الملف 'قم ببتعديل الوقت بما يناسبك Application.OnTime Now + TimeValue("00:00:10"), "ExportSpecificSheet" End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Option Explicit Sub ExportSpecificSheet() 'حدد مسار الملف Const FolderPath As String = "D:\" 'اسم الملف Const FileName As String = "نسخة من البيان الوقتى" 'حدد اسم الشيت Const SheetName As String = "Sheet2" If Evaluate("Isref('" & SheetName & "'!A1)") Then On Error Resume Next Workbooks(FileName).Close On Error GoTo 0 With ThisWorkbook Application.ScreenUpdating = False .Sheets(SheetName).Copy With ActiveWorkbook Dim ws As Worksheet: Set ws = ActiveSheet With ws.UsedRange .Value = .Value End With Application.DisplayAlerts = False .SaveAs FolderPath & FileName & " " & Format(Now, "dd-mm-yyyy hh-mm-ss") & ".xlsx" 'امتداد الملف Application.DisplayAlerts = True .Close False End With Application.ScreenUpdating = True End With MsgBox "Your's Sheet Exported Now ...", 64 End If End Sub بيان وقتى 2.xlsm 1 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.