أبو قاسم قام بنشر يناير 22 مشاركة قام بنشر يناير 22 (معدل) السلام عليكم رحمة الله وبركاتة نمودج.xlsb نمودج.xlsb تم تعديل يناير 22 بواسطه أبو قاسم اضافة رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر يناير 23 أفضل إجابة مشاركة قام بنشر يناير 23 وعليكم السلام ورحمة الله تعالى وبركاته Sub Copy_Sheet() 'انشاء ورقة جديدة وتسميتها وفق التسلسل المطلوب Dim f As Worksheet, Msg As Variant, Data As Worksheet Dim WSname As String, Cpt As String Set Data = Sheets("T1") WSname = "SMS" & Format(Date, "DDMMYY") Msg = MsgBox("انشاء ورقة جديدة؟", vbYesNo, WSname) If Msg <> vbYes Then Exit Sub With Application .ScreenUpdating = False .DisplayAlerts = False On Error Resume Next Cpt = Worksheets(WSname).Name If Cpt = "" Then Data.Copy after:=ActiveWorkbook.Sheets(Worksheets.Count) ' اظافة تاريخ واسم اليوم Set f = ActiveSheet f.Name = WSname: f.[E1].Value = Date: f.[C1].Value = Format(Date, "DDDD") '*******للاحتفاظ بالصيغ يمكنك الغاء هدا السطر With f.ListObjects(1).DataBodyRange .Value = .Value End With '********************************************** Else MsgBox "ورقة العمل موجودة مسيقا" & _ "", vbInformation, WSname End If .ScreenUpdating = True .DisplayAlerts = True End With End Sub Sub Save_folder_PDF() 'PDF '<-- حفظ داخل مجلد في نفس مسار الملف الرئيسي Dim WS As Worksheet: Set WS = ActiveWorkbook.Sheets(Worksheets.Count) Dim path As String, folderName As String, Fname As String, Msg As Variant Msg = MsgBox("؟" & " " & "PDF " & ":" & " تصدير الملف بصيغة", vbYesNo, WS.Name) If Msg <> vbYes Then Exit Sub With Application .ScreenUpdating = False .DisplayAlerts = False On Error Resume Next path = ThisWorkbook.path & "\" folderName = "ملفات PDF" MkDir path & folderName Fname = folderName & "\" & WS.Name & ".pdf" WS.ExportAsFixedFormat Type:=xlTypePDF, fileName:=path & Fname ScreenUpdating = True .DisplayAlerts = True End With MsgBox "تم حفظ الملف بنجاح" & vbLf & vbLf & path & _ "", vbInformation, folderName On Error GoTo 0 End Sub Sub Save_folder_Excel() 'Excel '<-- حفظ داخل مجلد في نفس مسار الملف الرئيسي Dim WS As Worksheet: Set WS = ActiveWorkbook.Sheets(Worksheets.Count) Dim path As String, folderName As String, Fname As String path = ThisWorkbook.path & "\" On Error Resume Next Msg = MsgBox("؟" & " " & "Excel " & ":" & " تصدير الملف بصيغة", vbYesNo, WS.Name) If Msg <> vbYes Then Exit Sub With Application .ScreenUpdating = False .DisplayAlerts = False folderName = "ملفات Excel" MkDir path & folderName Fname = folderName & "\" & WS.Name WS.Copy Application.ActiveWorkbook.SaveAs fileName:=path & Fname & ".xlsx", FileFormat:=51 ActiveWorkbook.Close .DisplayAlerts = True .ScreenUpdating = True End With On Error GoTo 0 MsgBox "تم حفظ الملف بنجاح" & vbLf & vbLf & path & _ "", vbInformation, folderName End Sub مع اظافة امكانية تنفيد الاكواد بطريقة اخرى ستجدها داخل الملف المرفق بالتوفيق... نمودج V2.xlsb 1 1 رابط هذا التعليق شارك More sharing options...
أبو قاسم قام بنشر يناير 23 الكاتب مشاركة قام بنشر يناير 23 جزاك الله خير مبدع ولك كل الشكر والتقدير 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان