T3965_Export To New Workbook Set New Invoice

https://excel-egy.com/forum/t3965
---------------------------------

Sub Export_To_New_Workbook_Set_New_Invoice()
    Dim fw, wb As Workbook, ws As Worksheet, d As Integer

    d = MsgBox("هل تريد حفظ الفاتورة الحالية وعمل فاتورة جديدة؟", vbYesNo, "رسـالة من المبرمج ")
    If d = vbYes Then
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
            fw = "D:\Invoice\فاتورة المصنع رقم_" & Range("D6").Value & ".xlsm"
            ThisWorkbook.SaveCopyAs fw
            Set wb = Workbooks.Open(fw)

            With wb
                For Each ws In wb.Worksheets
                    If ws.Name <> "Sheet1" Then ws.Delete
                Next ws
                With wb.Worksheets(1)
                    On Error Resume Next
                        .Columns("I:L").Delete
                        .Shapes("Rounded Rectangle 6").Delete
                    On Error GoTo 0
                End With
                wb.Close True
            End With

            With ThisWorkbook.Worksheets("Sheet1")
                .Range("D6").Value = "00" & .Range("D6").Value + 1
                .Range("B13:E25").ClearContents
            End With
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    Else
        MsgBox "لم يتم حفظ الفاتورة الحالية ولا عمل فاتورة جديدة", vbExclamation, "رسـالة من المبرمج "
    End If
End Sub