اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

  • أفضل إجابة
قام بنشر (معدل)

وعليكم السلام جرب الملف المرفق

 

Sub SaveWorkbookWithPasswordMonthYear()
    Dim originalWorkbook As Workbook
    Dim newWorkbook As Workbook
    Dim newFilePath As String
    Dim password As String
    Dim monthYear As String
    
    ' تعيين الملف الأصلي
    Set originalWorkbook = ThisWorkbook
    
    ' الحصول على اسم الشهر والسنة الحاليين
    monthYear = Format(Date, "mmmm yyyy")
    
    ' تحديد مسار الملف الجديد مع اسم الشهر والسنة
    newFilePath = Application.GetSaveAsFilename(InitialFileName:=monthYear & ".xlsb", FileFilter:="Excel Files (*.xlsb), *.xlsb")
    
    ' تعيين كلمة المرور
    password = InputBox("أدخل كلمة المرور للملف الجديد:")
    
    ' حفظ نسخة من الملف الأصلي
    originalWorkbook.SaveCopyAs newFilePath
    
    ' فتح النسخة الجديدة
    Set newWorkbook = Workbooks.Open(newFilePath)
    
    ' حفظ النسخة الجديدة مع كلمة المرور
    newWorkbook.SaveAs Filename:=newFilePath, password:=password
    
    ' إغلاق النسخة الجديدة
    newWorkbook.Close SaveChanges:=True
    
    MsgBox "تم حفظ النسخة الجديدة باسم الشهر والسنة وكلمة المرور بنجاح!"
End Sub

سلف شهر 8.xlsb

 

تم تعديل بواسطه عبدالله بشير عبدالله
  • Like 4
زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information